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To generate a directional magnetogram from original Spectra-Spectroheliograph 
data is a four pass process. Using the microdensitometer PASS!' scans the film 
to produce disk files numbered sequentially iwhich contain the raw scan data, 
PASS2 may be used at any time in the process (i.e, when the disk gets full) 
to organize the data into a workable form and put this data on magtape. 

After all the data has been put on magtape PASS3 can be started which determines 
the field strength, angle, and velocities at each point on the sun. Near the 
end of the PASS 3 run the computer requests a new magtape to output the final 
magnetograph. PASSh can be used to examine the magnetograph final tape to 
produce any of eight types of magnetogram pictures (using the microdensitometer) 
or for types of vector magnetograms ( using the Tektronix display scan). 

This manual for use on the magnetograph program describes; 1, black box use 
of the program, 2. the magtape data foimats used, 3* the adjustable control 
parameters in the program, and 4. the algorithms. With no adjustments on the 
control parameters this program may be used purely as a black box. For optimal 
use, however, the control parameters may be varied. The magtape data formats 
are of use in adopting other programs to look at raw data or final magnetograph 
data. For completeness I have included elaborate descriptions of how things 
work. 
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The sections of this manml are ordered as follows: 


1. Using the Program - A Typical Run 

1.1 About the Film - IX Coordinate and Polarization Pair 

1.2 Densitometer Setup 

1.3 Initializing the Computer System 
A Warning 

1.5 Zeroing the Microdensltometer 

1.6 Labeling the Output File 

1.7 User Defined Input Parameters 

1.8 The Densitometer Scan 

1.9 PASS2 

1.10 The Next Densitometer Scan 

1.11 After the Data Tape is Done 

1.12 PASS4 

2. Data Formats 

2.1 Disk Data Files after PASSl 

2.2 Data Tape Foimat after PASS2 

2.3 Data Tape Format for Magnetogram after PASS 3 
2,k Disk Picture Files from PASSU 

3. Control Parameters and Program Relinking 

3.1 PASS2C,PTN 

3.2 PASS3D.FTN 
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k. Algorithms 


hr.l PASS2 
1+.2 PASS3 
14.. 3 PASSll- 


1. Using the Progrsan - A Typical Run 


Given spectra-spectroheliograph data covering a region on the sun, information 
is available to readily determine velocities, B field strengths, and B field 
angles. This section describes a foixr pass computer process which is capable of 
deriving this information from the raw data. The sub-sections of this part of 
the manual are sequentially ordered to present the complete process of how to 
make a final vector magnetogram from the raw film data. 


1.1 About the Film - IX Coordinate and Polarization Pair 

The spectra-spectroheliograph film has two basic formats, the old type, and the 
new type, which are shown in Figure 1.1. The basic characteristics of these 
two types are different and it is important when running PASSl to distinguish 
between them. 

A COMPLETE RUN is composed of several REGION SCANS which are each composed of 
many SLIT PAIRS. Before each REGION SCAN the spectra-spectroheliograph was 
pointed at some initial solar coordinate and allowed to step aci*oss the 
region making many SLIT PAIRS each at a different X coordinate. After a change 
in polaroids the next REGION SCAN was begun. In each REGION SCAN the same 
pattein of spots was crossed and a similar looking sequence of SUCT PAIiS 
encountered. 
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It is extremely important that the film be correctly identified or the analysis 
cannot correctly proceed. Each SLIT PAIR is identified by an X coordinate in- 
teger vhich I refer to as IX. IX seq^uentially increases as each SLIT PAIR in a 
REGION SCAN is crossed. Also IX is the same for SLIT PAIRS that were taken at 
the same solar coordinate in separate REGION SCAN's of the same COMPLETE RUN. 

It is essential that (l) IX Increase sequentially and (2) that an accurate 
corresponse exist between the SLIT PAIR numbering and the actual solar coordi- 
nates. 

Sometimes only a portion of a REGION SCAN needs be analyzed which places one 
more restriction on IX. I introduce the term ANALYZING SCAN to represent 
that portion of the REGION SCAN that is analyzed. Just as there may be four 
REGION SCANS for a COMPLETE RUN there may be (at most) four ANALYZING SCANS. 
Figure 1.2 portrays how the ANALYZING SCAN fits in. Note that each ANALYZING 
SCAN in a COMPLETE RUN contains the same set of IX coordinates. Also note 
that the first SCAN PAIR of the ANALYZING SCAN is labeled IX=1. This is the 
third and last restriction on IX. 

In addition to IX each SCAN PAIR has another characteristic associated with it. 
This characteristic is its polarization. Each pair physically represents the 
light in two mutually orthogonal polarizations. Thus a SCAN APAIR may repre- 
sent RHC-LHC polarizations, or linear-ST*" - linear 127®, a linear 0® - linear 
-90°. Each REGION SCAN has associated with it one such polarization pair, and 
all the SCAN PAIRS in that REGION SCAN WERE TAKEN through the same pair of 
polaroids . 
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Each SCAN PAIK can thus be uniquely identified by IX and its polarization pair. 


1.2 Densitometer Setup 

Densitometer Setup requires two operations. First the film must be properly 
cleaned and placed on the platten. Second the microdensitometer must be 
calibrated and focused for the film. 

The film should be cleaned and placed on the platten such that the REGION SCAN 
begins on the right and ends somewhere in the roll on the left. IX = 1 should 
be placed somewhere near the right edge of the platten with IX increasing to 
the left (as the densitometer is faced). The film must be aligned such that 
the film edge lies precisely parallel to the microdensitometer X ajcis. This 
can be checked by running the densitometer back and forth in manual. 

Once aligned the densitometer may be precisely focused, a small aperture 
installed and aligned, and the transmission set for a clear portion of the 
film. The exact procedure is not described here as an elaborate method is given 
in the ^Microdensitometer System' by Steve Schoolman, 


1. 3 Initializing the Computer System 

Using the program PIP on the PDP-11 system initialization of the DISK and the 
MAGTAPE can be accomplished, A SCRATCH disk shoxild be installed and running 
on DK0, and a blank tape running on MT0. 
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Five restrictions exist for the scratch disk. First, at least 3000 blocks of free 
disk must be freed. Second, a file called NUMBER must be deleted from the user’s 
directory. Third, a file called FARM must be deleted from the user’s directory. 
All these conditions can be met using PIP. Third, the file PASSl.LDA must be 
present on the disk. Fourth, the file PASS2.LDA must be present on the disk. 

Both of these files can be found on MAGTAPE S-24 under the User Initials [2,ll] 
(please do not zero this tape). 

It is necessary that a ZERO mark be present on the output tape. If one is, no 
more action need be taken. If one is not the command MT0=/ZE in PIP will zero 
the tape (and wipe out anything already on the tape). 


Once both the disk and tape are readied the program is ready to begin. 


l.U A Warning 

The program PASS2 has defined within a BLOCK DATA statement all the program 
control parameters. In general those parameters should work for any piece of 
film. However, a new dimension in film size or raw step wedge data could lead 
to trouble. It may be necessary under unusual conditions to alter the control 
parameters and re -link PASS2 Section 3 of this booklet describes the conditions 
and the procedures under which PASS2 should be altered. 
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1.5 Zeroing the Ml erode nsltometer 


Zeroing is accomplished with the program PASSl.LDA. which should be called in 
from disk and running. PASSl is Just the system program TRACE with one alteration 
-it smooths data as it scans which TRACE does not do, PASSl (and TRACE) is a 
user interaction program with many features only a few of which I describe here. 
PASSl is in idle and waiting for a user response if a * is the last display 
character. 

With the densitometer in MAHIEL the densitometer Y should be moved to 
STARTING POSITION 1 on the film (see Figure 1.2). Z is the command which will 
then zero the reading to this starting point. 


1.6 Labeling the Output File 

The command T in PASSl causes the computer to respond with: 

IDENT: 

After which the user can enter a label of 31 characters length or less. A typical 
label identifies the region and the time of the COMPLETE RUN. 


1.7 User Defined Input Parameters 

Essentially three decisions are now left up to the user. He may select the 
parameter L == length of film he wants to scan (microns), /DC = the resolution 
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needed in X (microns), and AY = the resolution reading in Y (microns). Typically 
these parameters are on the order of L = 15cm - 150,000 jJi, AX = AY = 200ij. 

Having decided on these parameters the \iser- computer dialogue should proceed 
as follows (computer response is underlined): 

For old data: 

USER-DEFINED SCAN PARAJ^TERS : 

X-DIR= + 

Y~DIR= - 

PATTER]N= R or E (user^s choice) 

DELTA X= value of AX <CR> 

F0INTS/LIEE= value of L/AX (^4, 576 ) <CR> 

YSTEP= value of AY <CR> 

LINES=^ value of 5T150/AY <CR> 

0 <£R> 

Y= 0 <GR> 

( remember the line feed termination character) 

For new data: 

* U 

USER-DEFUiTED SCAR PARAMETERS ; 

X-DIR= + 

Y-DIR= ** 

PATTERN= R or E (user's choice) 
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delta. X= value of AX <CK> 


P0INTS/LINE= value of l/AX <CR> 

YSTEP^ value of AY <CE> 

LIHES=^ value of 30,000./AY <CIt> 

^ </) <CR> 

Y= 0 <CR> 

0 <CR> 

Y= -30^0 <liF> 

( remember the line feed) • 


If errors are made on this input it my be corrected by typing U again - this time 
the computer will respond: 

* U 

OPTION: 

Correction may be made to any of the parameters by selecting the appropriate 
option. These are the options: 

U - complete dialogue 
X - X direction 
Y - Y direction 
P - Pattern 

C - Starting coordinates 
DX - Delta X 
BY - Y step 

NP - Number of points per line 
NL - Number of lines 
E - exit to monitor from PASSl, 
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1.6 The DENSiaX)MBTBR SCAN 


Nov the actual DENSITOMETER SCAN can begin. The intiating character for the 
scaji is S. PASSl first opens a file for output of the data on disk, and then 
proceeds to scan recording the data on disk. At the end of the scan a * flashes 
on the display screen and the process may continue. 


1.9 PASS2 


Generally speaking one densitometer scan is enough to fill up the disk. PASS2 
should therefore be called after each densitometer scan to move the data onto 
tape, 

PASS2 first will ask to know which files it is to work on off of disk. This is 
specified by the letter which identifies the file on disk and the number of the 
first and last file to be analyzed from disk (these two numbers may be if 

only one file is to be analyzed). 

When PASS2 is brought into core for the first time during a COMPLETE RUN it 
must be initialized with certain parameters. It will ask for the following 
parameters; 

WAVELENGTH SCALE (MICRONS WAVELENGTH/mICRON ON FILM) 

(crl.U^000E-6) 

XSTEP (seconds of ARC /SLIT PAIR) fcrO.5) 
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YUNIT (SECONDS OF ARC/^CRON ON FILM) ^38^^E-3) 

WAVELENG'ffi OF FILM LEADING EDGE (MICRONS) (^52.4994) 

WAVELENGTH OF LINE CENTER (MICRONS) («52.502) 

WAVELENGTH OP ANY CALIBRATION LINES (NONE - <CK>) 

Next PASS2 will tell which data file it has opened eind request input of the 
initial IX value for the densitometer scan. IX=1 for the first scan or in 
general it is equal to the value of IX for the first SLIT PAIR in the DENSITCMETER 
SCAN. 


PASS2 will next request the two oid:;hogonal polarizations of the SLIT PAIRs in 
this DENSITOMETER SCAN. The information for RHC polarization is coded 511^ and 
for LHC polarization 256. Linear polarization is entered by the angle of the 
Polaroid in degrees from the X-scan direction on the sun. 

PASS2 will then proceed to move this data onto tape in a more convenient format. 
As a warning PASS2 requires 100 contiguous scratch disk blocks. If it cannot 
allogate this space a STOP 0^0001 will occur. This situation can be remedied 
by using the /PK switch in PIP or by deleting more files on disk and rerunning 
PASS2. PASS2 takes approximately 15 minutes to run through a full DENSITOMETER 
SCAN file. 
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1.10 The Next DENSITOMETER S(M 


Once PASS2 and PASSl have run the files PAHM and NUMBER should he present on 
dish. Do not delete either of these two files until the end of the COMPLETE 
RUN. Once again, though, room must he made on disk which can he accomplished 
by deleting the old data file. Once the disk is readied the next DENSITOMETER 
SCAN may begin. 

Move the film on the FLATTEN to the next starting point on the film (see Figure 
1.2). Once again the Densitometer must he properly calibrated and the film set 
parallel to the Densitometer X axis (see Section 1.2). Once done, PASSl must 
be rerun and zeroing (section 1.5)^ labeling (section 1.6), and initialization 
of input parameters (section I.7) redone. Please note that the input parameters 
L and AX may vary from DENSITOMETER SCAN to DENSITOMETER SCAN, but that AY must 
not change, (as L, AX, AY are defined in section 1.7)» After all is readied S 
(see section 1.8) initializes the DENSITOMETER SCAN. 

After the SCAN PASS2 should be run. This time through, PASS2 will ask only for 
the data file letter and number, IX for the first SLIT PAIR in this DENSITOMETER 
SCAN, and for the orthogonal polarizations of this DENSITOMETER SCAN. After 
PASS2 finishes this DENSITOMETER SCAN will have been completely moved to tape and 
the next DENSITOMETER SCAN begun. 
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1.11 After the Data Tape Is Done 


After the last of the DENSITOMETER SCANS In the COMPLETE RUN has been moved to 
tape by PASS2 the actual magnetic field information can be processed. PASS3 
performs this function. 

PASS3 is recorded on tape S-2l4- under the UIC (2,ll) and must be moved to disk 
before being run. Three considerations should be made before running PASS3. 

First, for optimal running the control parameters should be correctly adjusted 
(see section 3 ). Second, PASS3 requires (number of points in X) ^number of 
points in Y)/6k blocks of contiguous scratch area on disk -which must be available. 
Third a -tape -with a correct zero mark should be ready and waiting for oui^ut of 
■the final magnetogram. 

When -the disk is ready and -the data -tape is mounted on and moved to the 
load point then PASS3 may be run. PASS3 first ret^uests the maximum picture 
dimensions and then a single letter -which defines the files on the data -tape 
to be processed, PASS3 then proceeds to process -the data which takes approxi- 
mately (Number points in X)->^(Number of Points in Y)/200 minu-tes. 

At the completion of -the da"ta processing, PASS3 will ring a bell and req[uest the 
final magnetogram tape be mounted on "unit MT^. Once loaded and an output file 
is assigned to unit 8, PASS3 should be continued. After output of -the magneto- 
gram PASS 3 -will re-wind the "tape and return control to the monitor. 
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1.12 PASS4 


Final display of the data from the magnetogram tape in various formats is 
possible using FABSh. FABSk requires only that the magnetogram tape be mounted 
on emd that sufficient space is available on disk for output of the picture. 

When FASSh is run it first will request assignment of the magnetogram file to 
tape unit 8. After a continuation is given by the user FABSk will request two 
integers, MODE and ITYPE. M0DE=O causes an exit to monitor. 'The other MODE and 
ITTPE possibilities are described: 

M0DE=1, ITYPE=1 - A dopplergram will be produced. The dopplergram is written 
on a disk file whose name is given by the program. This file may later be 
output on the densitometer as a picture. 

M0DE:=1, ITYPE=2 - A magnetogram will be produced. The magnetogram is written on 
a disk file which may later be rendered as a photograph by the densitometer. 

M0DE=1, ITyPE*»3 - A gamma-gram is produced. This disk file may later be rendered 
on the densitometer as a photograph which displays fields toward the observer 
a block (O® yields transmission of O) and fields away from the observer as 
white (180® yields transmission of 1023). 

MODE-1, ITTPE=U - A phi-gram is produced. This disk file may later be rendered 
on the densitometer as a photograph which displays fields in the X scan direction 
as black (0° yields transmission of O) and fields in the -X scan direction as 
white (180* yields transmission of l80°). 
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MODE =2, ITY’PE=1 - A longitudinal magnetogram is produced, B cos (6) is written 
on the output file which may later be rendered as a photograph. 

MODE ^ 2 , ITYPE=2 - A transverse magnetogram is produced, B sin (6) is written on 
the output file which may later be rendered as a photograph. 

MODE =3, ITYPE=1 - Three longitudinal magnetograms are produced each representing 
a different color. B cos (6) is written on the output files, and the color wheel 
red-blue -yellow represents the field angle of going from 0® to l80® from the X 
scan direction. 

M0DE=3, ITYPE=2 - Three transverse magnetograms are produced each representing 
a different color. B sin (6) is written on the output files, and the color 
wheel red-blue -yellow represents the field angle going from 0® to l80° from 
the X scan direction. 

M0DE=4, IT5fPE=l - A vector magnetogram is displayed on the tektronix screen 
as seen from the viewing angle (6, as requested by the program. All fields 
are displayed which are greater then BMIN (program request) as vectors of 
equal length which point in the direction of the field and are anchored to the 
surface of the sun in the appropriate location. After con^jletion of the drawing 
the bell is sounded. Striking a return on the keyboard will cause a hardcopy 
to be produced and the program to continue . 

M0DE=5> ITYPE=1 - A vector magnetogreim is displayed on the tektronix screen as 
seen from the viewing angle (6, ) (program request). All fields are displayed 

which are greater than BMIN (program request) as vectors of relative length 


l6 



vhich point in the direction of the field and are anchored to the surface of 
the sun in the appropriate location. After completion of the drawing the hell 
is sounded and a return from the keyboard will cause a hardcopy to be produced. 

The files that have been created by PASS4 in inodes 1 throu^ 3 inay "be rendered 
as photographs by the densitometer using the system program TRACE, Setup of the 
densitometer is described in the "Operator's Manual for Microdensitometer Control 
Program^ by Steve Schoolman. The film should be on the platten with the densito- 
meter at the lower-left of the film. Playback of the photograph is initiated by 
the P command in running TRACE. 

^ RUN TRACE 
MONITOR 

* Z 

* P 

the computer then responds and the dialogue continues: 

SCALE FACTOR user’s choice 1 to 100 <CR> 

FARAMSTER SOURCE? R 

FCTfE NAME: complete name of file created by PASS4- <CR> 

TYPE ANY KEY TO CONTINUE 

C 

With the lights out and the film placed on the platten the user may initiate the 
picture output by typing any character. Completion of the picture output is 
signified by a bell. 
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2. Data Formats 

Often times the user may vant to use the output data or the output magnetogram In 
ways that are not possible through this system. In order to allow for easy use 
of the output information I nofw describe the data formats Tdiich are used. 

I describe here a total of four data formats. They are: l) The format of the 

data at the end of PASSl as it is stored on disk, 2) the format of the data 
tape as it is produced by PASS2, 3 ) the format of the magnetogram tape as pro- 
duced by PASS3> and k) the format of the picture records as produced by PASS4 
in modes 1 through 3* 

Each of these total mediums will contain one or many files each of which will 
contain many Fortran unformatted records. Each record must be read in a single 
Fortran READ statement and may contain as many as 12000 integer words (2 bytes 
each). All the records, in all the files, in all four storage media are of the 
same general format. The first word of each record is a code word, which de- 
scribes the nature of the record, and the second word is a length word which 
tells how many words remain in the second. The rest of the record contains 
the desired information. 


2.1 Disk Data Files after PASSl 


Each disk data file contains microdensitometer data from one DENSITOMETER SCANS 
A COMPLETE RUN is liable to consist of many DENSITOMETER SCANS and so many of 
these data files. 
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The data file consists of many records. The first two or three of these 
records contains control information and then each additional record contains 
the raw densitometer data from each line of the scan, one record to each line. 
The record contains the following. 

HECORD 1 = Label: 

WORD 1 = ICODE - 1 or 4 
WORD 2 = N 

WORD 3 to WORD N+2 = a label 2N bytes long 

RECORD 2 = Message (optional) 

WORD 1 = ICODE = 2 
WORD 2 = W 

WORD 3 to WORD N+2 = a message 2N bytes long 

RECORD 2 or 3 = Parameters 
WORD 1 - ICODE = 3 
WORD 2 ^ N = l4l 

WORD 3 = NPPL = Rmber of points per DENSITOMETER SCAN line. 
WORD 6 = IDEILX = distance between points in microns, 

WORD 7 = IDELY - distance between lines in microns. 

WORD 10 = NLPF - number of lines per frame (for old data this 
is the number of lines for new data this is half the 
nxanber of lines), 

WORD 11 = -1 for raster pattern, 0 for edge scan pattern. 

WORD l4 - 0 for old data, 2 for new data. 
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RECORD 3+ or 4+ = Densitometer Data. 

WORD 1 = ICODE = - line number 

WORD 2 - N « NPPL 

WORD 3 to WORD N+2 = the ddta. 

More information is available in the parameter record than is defined here. 

A complete description can be found in the output Format section of the * Operator 
Manual to Trace' by S. Schoolman. 


2.2 Data Tape Format After PASS2 

The data tape produced by PASS2 contains a sequence of files labeled <letter> 
n.DAT where n varies from 1 to the total number of DENSITOMETER SCARS in the 
COMPLETE RUN, Bach of these files contains the following sequence of records: 

RECORD 1 = Label 

WORD 1 = ICODE =1 
WORD 2 = N 

WORD 3 to WORD N+2 = label of length 2N bytes. 

RECORD 2 = Parameters 
WORD 1 = IC0DE=2 
WORD 2 = N = 10 

WORD 3 and 4 - XSTEP = seconds of arc per step in scan direction 


real number four bytes long). 



WORD 5 8t 6 = YSOEP = seconds of arc per step in Y (real), 

WORD 7 & 8 = ZStEEP = microns wavelength between data points (real). 

WORD 9 & 10 = ZCEW = microns wavelength of centerline (real), 

WORD 11 = NY = number of steps in the Y direction. 

WORD 12 - 1 if old data, 2 if new data. 

RECORD 3+ = Data for one slit crossing of SLIT PAIR. 

WORD 1 = ICODE = 0 
WORD 2 = N 

WORD 3 = J = number of densitometer points in this slit crossing. 
WORD 4 - IX = X step number of SLIT PAIR, 

WORD 5 = lY = Y step number. 

WORD 6 & 7 = = number of steps from first densitometer point 

to line center (real). 

WORD 8 = IPOL = Polaroid for this slit crossing (RHC-511^ LHC-256, 
linear integer angle in degrees), 

WORD 9 to WORD J+8 = film transmission smoothed and photometered, 

2.3 Data Tape Format for Magnetogram After PASS3 

This tape has only one file for the COMPLETE RUN, Each record contains information 
on one coordinate point encoded as follows: 

RECORD 1 = Label 

WORD 1 = ICODE = 1 
WORD 2 = N 

WORD 3 to WORD N+2 = label of length 2N bytes 
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BECORD 2 = Parameters 


WORD 1 = ICODE = 2 
WORD 2 = N = 6 

WORD 3 & 4 = XSTEP = seconds of arc per step in X (real, four 
bytes long). 

WORD 5 & 6 = YSTEP = seconds of arc per step in Y (real). 

WORD 7 ^ = total n\miber of steps in X direction. 

WORD 8 = T9Y = total number of steps in Y direction. 

RECORD 3+ = Data 

WORD 1 = ICODE = 0. 

WORD 2 = N = 10 

WORD 3 = IX = number of X step for this data point. 

WORD 4 = lY = number of Y step for this data point. 

WORD 5 & 6 = V = velocity (Km/sec, positive-dovnvard) (real). 
WORD 7 & 8 = B = field strength (gauss) (real). 

WORD 9 10 = 0AM s= field angle in degrees from the line of 

Eight (real). 

WORD 11 & 12 = PHI = field angle in degrees from X (real). 


2.4 Disk Picture Files from PASS4 


Each picture is encoded on one file. The records are in the same format as 

those output by PASSl, i.e, capable of controlling the microdensitometer program 
TRA.CE: 
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RECORD 1 = Label 


WORD 1 = ICODE = k 
WORD 2 == W 

WORD 3 to WORD W+2 = label of length 2N bytes. 


RECORD 2 = Message 

WORD 1 = ICODE = 2 
WORD 2 = N 

WORD 3 to WORD N+2 = message. 

RECORD 3 = Parameters 
WORD 1 - ICODE =3 
WORD 2 = N = l4l 

WORD 3 - KPPL = number of points per line. 

WORD 6 = IDELX = number of microns between output points in X=10. 
WORD 7 = IDELY = number of microns between output points in Y-10. 
WORD 10 = NL = number of lines in output picture. 

WORD 12 = ISPEED = 6k 

All other words in this record are zero. 


RECORD iH- = Data 

WORD 1 = ICODE =: -line number 
WORD 2 = N 

WORD 3 to WORD N+2 = transmissions of points on line. 



3. Control Parameters and Program Relinking 


On tape S-2il- all the necessary programs are stored for making a magnetogram. 
S-2il- contains the following files under UIC [ 2 , 11 ] : 


PASSl.LDA 

PASS3A.FTN 

PASS2.LDA 

PASS3B.FTN 

PASS3.LDA 

PASS3C.FTN 

PASSL.LDA 

PASS3D.FTN 

PASS2A.FTN 

PASS^A.FTN 

PASS2B.FTN 

PASS4B.FTN 

PASS2C.FTN 

PASS^C.FTN 


DELETE. me 


Direct running can he accomplished using the default control parameters in 
the load modules. The control parameters for PASS2 are contained in PASS2C.FTN 
and the control parameters for PASS 3 are contained in PASS3D»FTN, If these 
files are altered then PASS2 or PASS3 must he recompiled with the /oN switch 
and relinked. If PASS2C.FTN is changed PASS2 must he linked from PASSA/^Cf 
PASS2B/(CtJ/PASS 2E,' and DELETE. If Pass 3D.FTN is altered then PASS 3 must he 
relinked from PASS 3 A/cC, PASS3B/ CCJ PASSSC/jG^. PASS3D, DELETE. 


Listings of these programs can he found at the end of this booklet. The 
listings are by file and give all the subprograms and programs used. 
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3.1 PASS2C.FTN 


PASS2C is a BLOCK DATA statement -which defines parameters in four common blocks. 
Each of these four commons is described with the parameters: 

/film/ contains all the information on the film dimensions. In practice this 
block is the most critical and these parameters must be changed in switching 
program use from old to new data. Five parameters in /FILM/ are adjustable 
SLT(l), SLT(2), SMARG(l), SMARG(2), SEFF. Figure 3 illustrates these dimensions 
for the new and the old film. Each parameter is described below: 

SLT(1)= size in microns of film of one slit crossing (default^ old data = 2644.0) 

SLT(2) = size in microns of film of second slit crossing in SLIT PAIR (default - 
old data = 2644.0) 

SMARG(i) - distance in microns of film between second slit crossing in SLIT PAIR 

to first slit crossing of next pair (default = old data == 3527. 0) 

SMARG(2) - distance in microns of film between first slit crossing in SLIT PAIR 

to second slit crossing in next pair (default = old data = 685) 

SEFF = distance around line center in microns wavelength which is useful - anything 
over this distance will be discoded (default = l) 

As a check 9500.0 microns represents the total recycling distance. No matter 
what value for SLT(1 & 2) and SMARG (l & 2) are used this check applies. 
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On the new filjn format these four parameters have the values: 


SLT(l) = 8500 . 

SLT( 2 ) - 8500. 

SMARG(l) = 1000* 

SMARG(2) = 1000. 

/dens/ contains only one parameter ICONTR. The progretm in attempting 
to find the leading edge of the film looks for a slope in transmission of ICONTR 
over ten points. For old data it looks for a drop in transmission of ICONTR; 
for new data, it looks for a rise in transmission of this amount. If a ST0P2 of 
the program results it is likely that this parameter was too large. 

/wedge/ contains step wedge data if it is available. Two Integer arrays are 
defined in /WEDGE/, ITRANS(ll) and INT(ll). ITRANS(n) represents the trans- 
mission reading that results for the corrected transmission INT(n). These two 
relations should be approximately linear, i.e. INT is approximately proportional 
to TRANS and ranges from about 0 to about 1000, NSTEP tells the number of 
useful steps in the wedge. If no correction is necessary or no wedge data is 
available then NOWEG =.TRUE. The default for this common is NOWEG=.TRUE. 

/buffer/ has only one adjustable number - that is the size of the array IBUF. 
This number represents the maximum densitometer line length and is determined 
by the amount of core available on the machine. The default value of 12288 is 
about the maximum that will run in a 24 k core machine. 
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3.2 PASS3D.FTW 


PASS3D is a BLOCK DATA, statement that contains program control parameters in 
four commons. These four commons are /PROFLE/, /LNPRM/, /fILTER/ , /FFT/ and 
are described as follovs: 


/PROFLE/ contains two numbers which characterize the line profile. XWTDTH 
represents the half -height field width of the line in microns wavelength. 


PKLTN represents the relative line depth (-^25 x (continuum intensity) /(line 
center intensity)). The intensity profile is assumed to be approximately 
lorentzian with the following relative curve; 


I = 


PKLIR 


V XWIDTH J 


+ 1 


The default values T^ich the program \ises are XWIDiH=.06E-2 microns wavelength 
and PKLIW=^. 


/LNPRM/ contains other line parameters that apply to splitting and the doppler 
line shift. Only one control parameter is settable in this block; that is GFAC 
= Lande^ g factor for the line in question. A default value of GFAC=3. 

is assumed by the program. 


The program is designed to act like many filters which sample the data at many 
points, /filter/ controls the nature of the filters. NSAMP, the first element 
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of /filter/ equals the number of bandpasses to be used by the program (< 15 and 

t 

odd)-XBAND is the bandpass of each filter in microns wavelength and XSTEP is 
the distance between bandpasses in microns wavelength. Default values are 
NSAMP=15, XBAW]>,01E-2, XSTEP=.03B-2, 

It is possible in this program to envoke an alternate routine for determining 
field strength, /FFT/ contains the control data for this routine, NOFFT=t.TRUE, 
causes this technique to be skipped altogehter, BMIK sets the lower limit of 
fields that this routine will consider. GBND gives the number of degrees around 
6 = 90 ° in which this routine is not called. The default values are presently 
set at NOFFT- . TRUE ♦ , BMIN=l800. (gauss), GBNO = 20, (degrees) , 

Algorithms 

The details of operation of PASS2, PASS3, and PASSil- are described here. PASS2 
and PASS4 are briefly and basically described, PASS 3 is described in greater 
rigor since this is where the real field determination goes on. 


h,l PASS2 


PASS2 has the function of converting microdensitometer raw data into manageable 
data records. The original microdensitometer data consists of records that 
represent DENSITOMETER SCAN lines. The final output tape saves only the useful 
data in records, one slit crossing to a record. 
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PASS2 has the goal to keep track of label records, correctly set and use control 
parameters, and breakdown of the data. In PASS2A.F1N the MAIN program is listed. 
Initialization and the keeping track of control parameters is done by the first 
part of the program (up to statement 4o)« The loop DO 60 contains the data 
examination part of the program. 

In the initialization phase two possible directions are taken. If this is the 
first time PASS2"is being run in a complete run (lFILl=l) then the program 
requests initial parameters which it stores in a data file SPAEM on disk. 

If this is not a first run (iFILl/l) then PASS2 sets the initial parameters by 
checking the file SPARM already on disk. 

The data reduction phase of loop DO 60 first opens data files for reading, then 
reads sequentially all the records on each of these files. As each record it 
reads it is processed according to what its code word ICODE implies. The actual 
breakdown of line data records is called if ICODE is negative. Under this condi- 
tion the loop DO 54 reads the data from the raw data file in a random access 
technique (using the subroutine READ). PRCSS then handles each line as it is 
given to it. 

PRCSS goes through a four step operation to break down a data line. First if the 
line was scanned backwards in a raster scan - the line is flipped (subroutine 
flip) . Second the edge of the first slit crossing on the line is found by 
CR3DEG. Third, the line is stepped through and broken down according to the 
distance given in the common /FILM/ and results are written on the scratch file 
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SCRTCH.^I34P, Fourth, after information for the tvo orthogonal polarizations is 
present in SCRTCH.MP (taJtes two line process for new data and a one line process 
for old data) it is rewritten on tape in a finalized form. 

This process continues until all the raw data files on disk are read. PASS2 then 
closes all its files and deletes SCRTCH.IMP. 


4.2 PASS3 

The heart of the operation is here. PASS 3 takes the data tape created by PASS2 
and yields magnetic field strengths, angles, and fluid velocities. In this 
section the mechanics of the operation is discussed. The theory behind the opera- 
tion is described in the Fourier Transform method by A, Title and T. Tarbell. 

Because of the severe space limitation on disk PASS3 must operate as a two step 
program. First data is read off of tape. As each data record is read all the 
essentials of that record (field, angles, velocity) are derived in the routine 
PRCSS using the routine PRMFFT. - As results come out they are 

recorded in an extremely condensed matter on a large continguous scratch file 
on disk. Finally after all the raw data has been looked at the computer re- 
quests a new tape be mounted for output of the final manetogram. PASS3 then 
begins its second phase of operation and moves data from the SCRATCH. file 
onto tape. Before exit SCRATCH. IMP is deleted. 
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It is vital to understand the structure of the in between scratch file to 
understand the program mechanics. Because it is contiguous this scratch file 
can be treated as a large array. 101 is a routine which gives SCRTCH.IMP this 
appearance. 101 references V, B, according to the coordinate IX, lY. 

Thus any velocity may be easily read or written for any point in the picture at 
any time in the execution. As field values are found from the data they are 
averaged with previous results (if there are any and wel^ted properly), and 
returned to SCRTCH.TMP over the old location. During a COMPLETE RIM as many as 
four values for the field may be determined for each point in the picture. 

These have been appropriately handled so as to take only one word on disk during 
the COMPLETE RIM. 

The work of PASS3 is carried out in PRMFFT and the routines it calls CONTRA, 
COMBINE, POLYAN, and BGOOD. In addition there are a set of operational routines 
that perform mathematical operation for ERMFFT, these are DSUM, COSTEIA, ZER, 
FLINT. 

Basically PRMFFT manages the fourier transform method of obtaining |b|, cosine 
Y, and the line of sight velocity. Subroutine CONTEiA determines the continuum 
values. COMBINE determines the line center position, and hence the line of 
sight velocity; while POLYAN manages the determination of the zero crossing, 
and cosine y. The value of the zero crossing is determined by ZER and COSTR 
calculates the required fourier transforms. The polynomial integration procedure 
for cosine gamma is performed in FLINT. Finally the values determined by the 
above routines are reviewed in BGOOD. The routine DSUM adds sets of values 
for a number of averaging processes. 
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4.3 PASS4 


There are no tricks in PASS4. The algorithms are obvious and strai^t forward. 
Given magnetogram data PASS4 can be used to constinict magnetogram picutres in any 
of twelve formats. 

MAIN (PASS4a) serves the function of detemnining which output feature is desired 
by the user, MAIN only sets certain variables which are then passed to the 
appropriate routines for handling. 

PICTTJE creates a file for the densitometer which can later be interpreted as a 
photograph. It uses the two routines LABEL, and SETSCL to write the label and 
parameter block of the output file. LNINT is where the work goes on, as this 
routine determines the actual intensity for the picture point being written, 
PICTUR may be called when MODE 1, 2, or 3 of the routine are entered. 

MODES k and 5 of the program cause the routine VECT. to be called from MAIN. 

YBCT examines the magnetogram data and constructs on the output screen a vector 
magnetogram according to specifications. 
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This is an example of a piece of spectra-spectraheliograph film with the terms identified. 

In the complete run of this example the region was scanned three times in three polarization 
pairs. REGION SCAN 1 was LHC, EHC. (IPOL = 256,511), REGION SCAN 2 was x,y (IPOL = 0,90), 
REGION SCAN 3 was in linear polarizations 4^,135^^ (IPOL = 45,135). Corresponding to the 
three REGION SCANS are three ANALYZING SCANS each of ’tdiich begin at the same point on the sun. 
This solar starting point is labeled IX = 1. In this example each ANALYZING SCAN took three 
separate DENSITOMETER SCANS. Each DENSITOMETER SCAN covered about 7 slit pairs (not clear 
in drawing, but may vary even in real run) . 



Figure 1.2 
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PASS 2 -data from disk TO Tape 

THIS program takes A SEQUENCE OF M iNpUT FIlES LABELED <CHAR>1.0A1 
TO <CHAR>M.DAT OF DFNSITIZED DATA AND PRODUCES AN OUTPUT TaPE 

OF identically labeled files with the^ data organized into small 
records each containing one slit crossing* The output data Tape 
contains se6iuenciAl files each file containing many records* 

EACH record is identified BY ITS FIRST WORD =IC0DE AND rY ITS 
Second wopm n which tells the length of the buffer to 
follow* within the buffer the information i5 coded aS follows: 
IC0DE=1 iBUFsLABEL of length n words. 

IC0DF=2,N*tBUF(1 and 2j2XSTEP=SEC0NDS of arc per X STEP(REAL). 

IBUF(3 and 4)=YSTEPxSeC0nDS OF ARC PER Y STEP. 

iBUFtS And 6) xZSTEPxMiCroNS of wavelength PER data point* 

IBUF(7 and 8) xZCEn=MICROnS wavelength of centerline. 

IBUF (9)=NlPF=NUMBER OF YSTEPS iN y DIMENSION* 

IBUF(10)=1 IF old DATa» 2 IF NEW dATa* 

ICOOEx0*N*IBUF(1)=J=NUmBER of points IN data REC0RD2N*6. 

IBUF (2) xIXxnUMbeR OF X STEP. 

IBUF ( 3) = IY-NUMbeR OF Y STEP, 

lBUFt4 AND 5):Z0 xNUMbER OF 2 SjEPS tREAL> pROM FiRST RECORD TO lINe 

center. ^ ^ 

IBUF (6) =IP0L=P0LARIZATI0N OE RECORD ( 5ll -R hC *256-LHC * 0 TO 180- 

LINEAR). « ^ r- 

IBUF(7> To lBUE(N>rFlLM DENSITIES *SmOOTHEd AND PHOTOMeTEREd . 

records are ordered in orthogonal polarity PAIRS sequentially 
IN TX FOR K STEPS* FOR EacH VALUE OF lY* 
laRRy November * 21-aug-Z3 
common /bUFFER/ICoDE • IBUF 4 1 ) 
dimension ZlNE ( 5 ) * iPoL I 2 ) *NUM ( 8 ^ * lEXT (*> ) 
logical end 

LOGICaL + 1 IfIL(10) *IFILnM 44 J •CHAR.42) 

equivalence (IFIL(1)*IEXT4i )),(IFlL(3)tlF iLnm41) ) * 

+ (CHAR (D *IChAR) 

DATA iEXt/’00’.*00*»»0‘?**!*D!**AT’/,ICHAR/* 0 V 

Call setfil ( 2 * *scrtch*tmp * * ierR * *dk « »0 *0 ***233*2) 

DEFINE file 2 4 S0 *512 , U * I VA R > 

WRITE(2 * 1 *ErR = 3) IDUMMY 
GO TO 4 

3 continue 
end file 2 

WRITE {6 * 1 00fl) lERR 
STOP 1 

4 continue 
WRITE (6*1 000) 

READ46*902> IFIL4 1 ) *IPIl1*IFIL2 

IF( IFlLl.EQ.l) GO To 6 

call SETfIL(1**SPaRM* ) 

read4i ) nlne*2unit*xstep* yunit*zlne 

END file 1 

GO TO 12 

6 continue 
write (6*1 001) 

RE’AD46*900) ZUnIT.XSTEP* YUNIT 

write (6*1 002) 

Read *900 ) zlne 4 i ) * zlne (2) 
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FORTRAN 

V004A 

00j23*48 01-JAN-*72 PAGE 

0028 


NLNES0 

0029 


DO 10 Ll = 3*fS 

0030 


WRITE ( 6 * 1 003) 

0031 


READ.t6*900) ZLNEtLl) 

0032 


IF (ZLNE (l 1 ) -EO.0* ) GO TO ll 

0033 


NLNE = NLNE<^1 

0034 

10 

continue 

0035 

11 

call SETfIL (1 • «SpaRM* ) 

0036 


WRITE (1 > NLNE*zUNlTtxSTEP»YUNlT fZLNE 

0037 


end file 1 

0038 

12 

Continue 

0039 


DO 60 L0zIFILl,IFlL2 

0040 


ENCODE (4, 1006*IFILNM) L0 

0041 


DO 13 Llrl*4 

0042 

13 

IF(IFILNMILI) •EQ*CHAR ( 1 ) ) IFIlNM (L l ) :C hAR ( 2 > 

0043 


WRITE (6*1007) IFIL 

0044 


Call seTfil(1 *ifil) 

0045 


call SETfIL(8*IFIL) 

0046 


WRITE (6*1005) 

004 7 


READt6*90l) IX 

0048 


WRITE ( 6 * 1 004 ) 

0049 


READ(6»901) IPOL 

0050 


call Curve 

0051 


IREC lz0 

0052 


IFr = 0 

0053 

15 

continue 

0054 


IREClzlRF.Cl4 1 

0055 


call READilRECI *Nt ICoDE » IBUF *END ) 

0056 


IF(END) GO to 55 

0057 


IFf ICODE.LF.0) go to 51 

0058 


GO TO ( 30 t 30 ,5g| » 30 ) *iCODE 

0059 

30 

ICODEzl 

0060 


WRITE (8) ICODE.N* (IBUF (lD *L1 = 1»N) 

0061 


GO TO 15 

0062 

50 

CALL sparm iibuf *2unit*xstep*yunit*nppl,nlpf *nFR, 



f lpat*zlne (2) »zsTep) 

0063 


GO To 15 

0064 

51 

DO 54 L1=1*NLPF 

^065 


DO 54 L2rl*NFR 

^066 


call pRCSSt 1 code > IBUF* IPOL, IX tLl ,2STEP , NLNE * ZLNE f 
♦ LPaT tNPPL *L2 *NfR ) 

^1067 


Call rEad( Ujfr-l2) *nlpf+li^-ireci,n*icode» ibuf *end 

^068 


IF(END) go to 55 

^069 

54 

COnT InUe 

5070 

55 

COnT InUE 

5071 


end file 1 

5072 


end file 8 

5073 

60 

continue 

5074 


end file 2 

5075 


call delete 

5076 

Q00 

Formatcei 0*0) 

5077 

Q0l 

format (13) 

5078 

q02 

F0RMAT( A1 */f I3,/*I3) 

5079 

1000 

FORMATC please SPECIFY DISK iNPuT FILES wITh ONE 


♦ * ID character <CR> (A1 format)**/ 

* * THEN SPECIFY THE FIRST FILE NUMBER IN ThE SEQ-*/ 
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ORTRAN V004A 


01-.JAN-7? PAGE 


^ 085 
^086 
^087 
^088 


♦ • UENCE <CR>. and THE LaST FIlE NUMBER <CR> FORMATS) •*/) 

1«01 formak* input wavelength scale (MIcROnS/mICRON on film)**/ 

♦ * then <cr>* XSTEP (seconds of ARO between SPECTRA»./ 

+ * then <cR>* yunit (seconds of arc per*/ 

♦ * MICRON on film* <CR>-fEl0.0 FORMAT^M/l 

1002 F0RMAT(* input wavelength OF film leading edge (MICROnS) <cr>*»/ 

♦ * wAvelength of Line center <cr>«*7) 

1003 format INPUT wavelengths OF ADDITIONAL lINES ON FILM’/ 

+ ’ then <CR>* or <CR> if no MORE**/) 

1004 F0RMAT(’ input polarization .(RHC-51i»LHC-256,LInEAR-ANGLE*/ 

+ • iN dEReES from rA 0-lfl0) OF FIRST IN PAIR <CR>*!/ 

♦ * OF second in pair <CR> 5l3 FORMAT)*’/) 

1005 FORMAK’ INPUT IX (SlIT STEPS) FOR FIRST INPuT RECORD*/ 

t ’ from beginning OF this scan (>0 with first Slit crossing./ 

♦ ♦ OF region scan = 1)(I3 FoRMaT)*/) 

1006 F ORMaT ( la ) 

1007 FORMAT!’ OPENING FILE !*10aD 

1008 format!’ err :FORT0010 ’ * I2* ♦ EXECUTION TERMINATED. 

END 


routines called: 
Setfil* curve * read 


spaRm 


PPCSS , delete 


SWITCHES = /ON 


BLOCK length 

MAIN* l39u !0053a4)* 

buffer P (000004) 

♦ ♦compiler CORE** 

PHASE USED free 

declaratives 0036c, 1;a425 
executables 0096? Ip82a 
assembly 0i72q la97q 
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"ORTrAN V004A 


00j2^ t 20 
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1 


0«01 subroutime read (newrec *n » icode » ibuf*End ) 

C READ A RANDOM ACCESS READ STATEMENT FOR dENSITOMETER 

c data records* newrec specifies The record to dE read* and 

C lCODF»N,lRuFt 1) TO IBUf(N) ARE THE INFORMATION ON ThaT RECoRD. END 
C IS Set .true* if an attempt has been made to read beyond 
c the last record of the file. 

0002 dimension iBUFfl) 

logical end 

0004 Data trec/0/ 

0005 £ND=*FALSE* 

0006 IF (NEwREC«IREC) 30»2s»T0 

0007 10 IREC=IREC+1 

0008 DO 20 Llr IREC * nEwREC 

0009 REaDU *END=g 0) ICODEtNf ( IB uF5l 2) ,L2rl *N) 

0010 20 continue 

0011 irec=newrec 

0012 25 Return 

00l 3 30 REWIND 1 

0014 IREC=0 

0015 GO TO 10 

0016 60 END=*TRUE* 

0017 return 

0018 END 

Switches - /on 

block length 

read i40 (0004^0)* 

♦+COMpILeR CORE+* 

PHASE USED FREE 

declaratives 0036f, 1:^425 
executables 00527 1.^264 
assembly 0099ft Is7l2 
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fortran V004A 


00j24;57 
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1 


0001 


0002 

0003 

0004 

0005 

0006 
0007 
0000 

0009 

0010 
0011 
0012 

001 3 

0014 

0015 
001 6 

0017 

0018 

0019 

0020 
0 021 
0022 

002 3 


subroutine SPARM,(iBUF*2UNIT»XSTEP*YUNit*NPPL ,NLPF*nPR* 

♦ LPAT»zCEN»25TEP ) 

C SPARM examines ThE PARAMETER RECORD OF THE iNPuT DENSITOMETER 
c Data and returns certain parameters essential for the program. 
c these parameters are: 
c nppl=numbeR of points per line. 

C nLPF=NUMBER of lines per FRAMErNUMBER OF YSTEPS IN SCaN. 

C lPAT=PaTTERN = .TRUE. if RASTER * .false. IF EDGE. 

C NFR=NUM8ER of FrAMES=1 IF OLD DATa* 2 IF NEW DATA. 

C In addition SPARm sets /FILM/ common aND writes The parameter reco 
c FOR the output Tape. 

common /fILM/SlTStP<2) *SMRSTP(2) *SEfF»SLT(2) ,SMaR6(2) .ZEFF 

dimension IbUFIU 
data ICOdE/ 2/ »N/l0/ 

NPpL-iBUF ( 1 ) 

iDELXrlflUF ( 4 ) 
iDELY^IBliF tS) 

NLPF=IBUF (8) 

LPaT=TBUF <9) 

NFR^IBUF ( 12 ) /2+1 
IF(NFR.LT-I) nfr=i 
IF(NFR.6T.2) NFR=2 

delx=idelx 

DO 10 Llil*2 

SLTSTP ( Ll ) =SLT ( LI ) /DEL x 

SMRSTP (Ll ) 2SMARG (Ll) /DELX 

10 continue 

YSTEPrYUNiTTFLoAT (IDELY) 

ZSTEPz/UnIT+DELX 

seff=zeff/2step 

WRITE (8) IC0DE*N*xSTEP’YSTEP»2STEP*2CEN»NLPF,NER 

return 

END 

routines Called: 
float 

switches = /ON 

BLOCK length 

SPaRM 278 (001054)+ 

film 20 ( 000050 ) 

♦ ♦compiler CORE** 

PHASE USED free 

declaratives 0036ft 1^425 
executables 00701 1:^090 
assembly 0i14i I 5567 
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0001 


0002 

000 3 

0004 

0005 

0006 
0007 
0006 
0009 

001 0 
0011 
0012 

0013 

0014 

0015 

0016 

0017 

0018 
001 9 
0020 
0021 
0022 

0023 

0024 

0025 

0026 

0027 

0028 

0029 

0030 

0031 

0032 

0033 

0034 

0035 

0036 

0037 

0038 

0039 

0040 

0041 

0042 

0043 

0044 

0045 


subroutine pRCSSllNiT tlDAT,lPOL*lX0,lY,Z5TEP,NLNE*ZLNF* 

♦ LPaT »nPPL»IFR*NFR) 

C PRCSS examines densitometer data records and produces 
C SEPERATfD output data records each containing information 
c foR a single slit CROSSING- 

C THIS IS A FOUR step PROCESS. FIRST* iF THE DATA l5 A RaSTeR RACK 

c Scan lime the data is flipped* second* cR^deg finds the 

c edge of The first slit crossing on the record* third* the program 
c walks through The line seperating out slit crossings and 

c writes these on a scratch file* fourth* data iS written on tape 

C IN A convenient order FOR LATER USE* 

dimension IdAT( 11 tlPoLlD *ZLNE(1> *ILNE (3) *lNT6l2) 

logical LPAT*LnlR*SKlP 

COMMON /fILM/SlT!2) *SMARG<?) *SEFF 

equivalence (InTG(D.REaLX) 

data ICODE/0/ 

IF f INIT. eQ*-!) L0IR=.TRUE* 

IF ( -NOT.lDIR ) call FLIP ( IDaT*nPPL> 

IF ( INIT.fO*“1> call CR3dEG( IOaT*zERO*NPPL*NFR) 

BUF-ZERO-SMaRG( IFR ) 

Lli0 

20 Ll=Ll4l 

IF(NhR.NF.2) Lp=L 1-2*{ tLl-1 )/2) 

IF t N[-R.E0*2) L2 = IFR 
BUF=BuF + SMARG.^l2) 

NBUF^nUFf .5+SLT (L2> 

IF (NBUF.gT.nPPD go to 40 
IREC2:NFr* lLl-1 J +IFR 
IDAT u )=SLT(L2) 

IF(SLT(L2) *GT*SEFf) IDat(1)=SEFF 

lDATt2)=lX0+(Ll-l)/2 

IDAT l.^)riY 

UrSLT ( L2>‘"SEFF 

IF(11.LT,0) Il20 

JlrBiiF + 1 . 

J2-BUF+SLT(l2) 

REALX = ZER < IdAT,J1,J2,NLNE*zLNE*ZSTEP*InIT)-FlOAT <Il/2) 
lDATt4) = lNTG Ul 
IOAT (5)=INTG(2 j 

l0AT(ft)=lP0L(L2) 
call PH0T( IDAT, Jl, J2) 

IlrSLT (L2> 

L4=BUF 

DBUF=BUF“FLOAT5l4 ) 

IWAY-+1 

IF IdBUF*GE-0. ) GO to 23 
IWAY=-1 

DBUF^ABS (dBUF ) 

23 DBUfI=1 **DBUF 

IF(SLT (L2) •LE-SEFF) gO TO p2 
IliSEFF 

L43BUF^-SEFF/2* 

22 Jl-7 

J2rIl+6 

DO 30 L3:J1#J2 
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2 


0046 

0047 

0048 

0049 

0050 

0051 

0052 

0053 

0054 

0055 

0056 

0057 

0058 

0059 
006fi 

routines called: 

FLIP ♦ CR3dEG, ZER * float » PHOT , AbS 
Switches = /on 
block length 

PRcSS r55 (0032r6J* 

film 10 (0000?4J 

♦ ♦compiler — CORE** 

PHASE USED FREE 

DECLARATIVES 0036f, 1.^425 
executables 0094r 1284;^ 
assembly 0151:^ Is195 


L4=L4.hl 

30 IDaT(l3)-DBUF^iDAT(L4-UWAY)*DBUFI*IDAT (L4) 
BUF=BUF+sLT (L2 ) 

WRITE ( 2 * IREC2 J J2 , ( IdAT (L3) fL.^ = l» J2 ) 

GO TO 20 
40 continue 

IF ( ifr.lt*nfR) return 

IF ( TREC2-.2* ( IREC2/2) .NE.0) IREC2z IREC2-1 

DO 50 Llzl*lREC2 

read I Li ) II * f ID aTIl 2) *L2:l»Il) 

WRITE (8) I CODE , I 1* ( iDAt (L2 ) iL2=l* ) 

50 continue 

IF(LPaT) ldiR= .N0T*LDIR 

Return 

end 


hi 
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0C01 subroutine flip(idat,n) 

c FLIP takes An array idat of lEngTh n and reverses The order of 
c the array elements. 


0002 

DIMENSION IdAT( 

000 3 

NPr 2N ♦ 1 

0004 

MID=N/2 

0005 

DO 10 Llrl’MlD 

0006 

Llp=NPl-Ll 

000 7 

IHLD=IDAT (LlP) 

000 8 

IDAT^LIP) =InAT< 

0009 

idatili>=ihld 

00l 0 

10 Continue 

0011 

return 

0012 

END 


Switches = /on 


length 

107 (0003JJ6)* 


BLOCK 
FLIP 

♦♦compiler - 
PHASE 

declaratives 

executables 

assembly 


CORE+* 
USED free 
00366 1342s 
00527 1:^264 
00940 ls76ft 
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-0001 


0 002 

0003 

0004 
0«05 
0«06 

0007 

0008 

0009 

0010 
0011 
0012 
0013 
00l 4 

0015 

0016 
0017 
00l 3 

0 019 
0 02 0 
0021 
0022 

0023 

0024 


function ZER( IDAT*J1,J2,NLNE*ZLNE»2STEPMNIT) 
c zeR determines the distance from the beginning of The slit 
C CROSSING To line CENTER BY CALIBRATING OfF OF lINE EDGE AND ANY 
C OTHER reference LINES IN THE FRAME. 
dimension IDAT (1 ) f2LNE U ) 
logical I N I T 
IF (NLNE.nE *0) GO TO 10 
IF ( .not • IN IT ) return 
ZER- <ZLNE t 2 ) »ZlNE ( 1) ) /ZSTeP 

return 
10 continue 
Zc = l* 

DO 40 Llil*NLNE 

ILNE- (ZLnE.^LI *-2) “ZLNE (1) ) /ZUNlT-i0. 

J2p= ILNE4 50 

J2m= ilne+10 

lOlFMr0 

DO 20 L2rILNE*j2P 

IDIF= I DAT <L2+J1+1)-IdAT {L2 + J1) 

IF ( lniF.LT .IDIfMJ GO TO 20 
IDlFMrlDlF 

L2m=L? 

20 continue 

40 ZCrZC+FL0AT{L2M)^Z5TEP/(ZLNEtLl + 2>-ZLNE<l) ) 

ZeR=2c /FLOAT ( NlNE +1 ) + ( 2LNE ( 2 > -ZlnE t i ) >/ZSTEP 

return 

END 

routines called: 

FLOAT 

Switches = /on 

BLOCK length 

ZER 326 (00l2i4)+ 

♦♦compiler CORE+* 

PHASE USED FREE 

declaratives 00446 1^34^ 
executables 0060? i^lSa 
assembly 0i 1>32 ls57f» 


^3 
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0001 


subroutine cR3dEG{ 1DaT*ZER,NPPL*nFR) 

CR3DEG FINDS THE EDGE oF THE FIRST SLiT CROSSING IN 

idat. iT looks for a slope in film densities that 
Than icontr over ten points. 


the data aj 
IS greater 


0002 


dimension IDATjD 

0005 


common /dEnS/ICONTR 

0004 


lOlFF (N fM ) = ( IDAT 5 n) -IDAT ( N + 

000S 


ISGN=1 

0006 


iFfNFR. EQ*2) ISGN=-1 

0007 


LlMlTNrNpPL/2 

0008 


DO 20 Ll-l *LIMIT n 

0009 


idif^idiff (l1m0) 

0010 


IF( IDIF.gT.ICONTR) go To 30 

0011 

20 

conT inue 

00l 2 


WRITE (6*1.000) 

0015 


STOP 2 

0014 

30 

NZER=L1*1 

0015 


IDIFM=0 

0016 


LlM = 0 

0017 


DO 40 Llrl*10 

0018 


IDIF21DIFF(nZER+L1»1) 

0019 


IF ( TDIF .lT.IDIFM) GO TO 40 

0020 


idifm= idif 

0021 


LlM=Ll 

0022 

40 

continue 

0025 


NZER2nZER+L1M 

0024 


zer^nzer 

0025 


return 

0026 

1000 

F0RMAT(' Err:CR3DEDG could 

0027 


end 


NOT FIND edge* EXECUTION TERMINATED*) 


S#^ITCHES : /ON 


BLOCK length 

CR?^DEG ?86 (001074) + 

DEnS 1 (000002) 


♦TCOMPILFR - 
PHASE 

declaratives 

EXECUTABLES 

assembly 


CORE+* 
USED FREE 
0036f> 1342 b 
006 lfc l3l7s 
0i24s 1s463 


hk 
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0001 


0002 

0003 


0004 

0005 

0006 

0007 

0008 

0009 

0010 
001 1 
0012 

0013 

0014 

0015 

0016 

0017 

0018 

0019 

0020 
0021 
0022 
002 3 

0024 

0025 

0026 

0027 

0028 


subroutine curve 

c photometry finds 1024 -exPOSURE as FCN of TRANS ./2 

C USES harvard photometry curve of JUNE* 197 i .^5 PERCeNT ) 

C T* TARbELL NOV. Iq* 197 ^ 

COMmON/CCURV/IPhOT ( 5 I 3 ) »kSmoOT 

data Cl *( 2*C?i*A0*A1 *A 2 *SlOPE *EINT*B 0 .Pl*p 2 ,S 2 *E 2 / 

1 p. 0 l 7 * 0 * 408 » 0 «lil 5 * 101 * 6 l t 2 i 8 - 26 *-l 3 *i*l 6 l«t> 3 tl 6 p- 5 ^, 

? 44 -/j 6 *- 77 ii 0 *^* 69480 .0 * 1571 *07 *- 12 ;^, 87 / 

DO 10 l=l» 5 l-n 
F=FlOAT(I) 

F = ALOG( 500 ./F)'»- 0-1 

IF (F-GT-cI) go To 1 

IF (F.GT-C 2 ) 60 To 2 

IF (F.GT.C 3 ) GO TO 3 

IPHoTI I ) = S 5 » + F + E 2 

IF I xPHoTt I ) - lT-D IPH 0 T<I )=1 

GO TO Q 

1 IPH 0 T(I> = SLOPE+F + EINT 

IF ( iPHOT ( I ) •gT- 1023 ) IPH 0 T 5 D = 1023 
GO to q 

2 iPHoTll) r A 0 ^Al^F ^ A 2 *F+F 

GO TO q 

3 IPHOT(I) = B 0 + SQrT(r 1 + B 2 *F) 

Q IPHOT(i) = 1 . 40 +IPHOT{I) 

IPHOT(I) - MAX 0 ( 1 * 1024 -IPHOT( n ) 

IPHOT ( I)=MIN0(1023,I phot ( I J ) 

10 continue 

write {6*1001 

100 format(/* Type i for smoothing* 0 for none*X) 
read (ft*l 0 l) ksmoot 

101 format ( 12 ) 

return 

END 

routines called: 

float * ALOG ♦ SORT * MAX 0 » MlN 0 

switches = /ON 

BLOCK length 

CURVE 422 ( 00 l 5 l 4 )* 

CCURV 5 I 4 ( 002004 ) 

♦♦compiler — core** 

PHASE USED FREE 

DECLARATIVES 0053 ? 1:^254 
executables 00687 l 3 l 04 
assembly 01397 ls 3 ll 
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fortran V004A 
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0001 

C 

C 

0002 

0003 

0004 

0005 

0006 

0007 

0008 
0009 

001-1 100 

001 1 
0012 

0013 

0014 

0015 200 

0016 
0017 


SUBROUTINE PHOT ( IDAT* J1 » j2 J 

converts from Transmission to (1024'^exposure) 

T* TARrELL NOV. iQf 197;^ 
dimension lOATllJt RAT(l0) 

common /WEDGF/NSTE:pS*NOl«fEO*lTRANS{ll) fiNTli 1) 

COMMON /CCURv/IPHOt (5i3) *K$M00T 

LOGICAL NOWEG 

OO 100 Lijl*j2 

LL=IDAT (L) /2 

IF(lL.iE«0) LL3i 

IF t lL -GE *^13) LL=5]3 

IDAT (L) = IPHOT (LL) 

IF (ksmoot.eo.0) return 

m2=j1+2 

M 3 =j 2-2 

do 200 LlrM2*M3 

I DAT (LI ) =0.4* (IDAT (LI) L0.5+ ( IOAT 5L1+1 IDAT (Ll-1 ) + 
0.5+ ( IdAT (L l+2) f IDAT (Ll*2> M ) 

RETuRN 

end 


Switches = /on 


length 

241 (000742)+ 

24 ( 0000 G 0 ) 

r14 (002004) 


block 
phot 
WE nGE 
CCURV 

♦♦compiler - 

PHASE 

declaratives 

EXECUTABLES 

assembly 


--- CORE** 
USED FREE 
0054q 1:^s242 
00607 I3I84 
0109fl le;6l0 


k 6 
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0H0 1 


0002 


000 3 

0004 

0005 

0006 


0007 
000 8 


BLOCK data 

c all the program control Parameters are set here* these para'* 

C are DESCRIBED: 

C /FiL M/rCONTAlNS INFORMATION ON FILM DIMENSIONS* 

C SLtU and 2)=MICR0NS across slit for first ti) aNd SECOND ^2) 

C orthogonal rOLa IZaTIoNS* 

C 5MARG(1 and 2)=MIcR0NS IN mARgIN PRIOR TO SLiT CROSSING* 

C ZEFF=nUMbER Of MIcROnS of useful data around line center. 

c /denS/=icontr=minimum Contrast between slit edge and maRgin* 

C /WEDGE/=StEP wedge data* 

C NOWEGr.TpUE. IF NO WEDGE INFORMATION IS AVAILABLE 

c nsteps=numbfR of wedge steps* 

c itrans (K ) ^Transmission of k-th step in wedge. 

C INT <K )=C0RRECT TRaNSmISSON OF K-TH STEP IN WEDgE* 

common /fILM/DuM1(5J*SLT<2) *SmARG t 2 ) »2 eFF 

♦ /DENS/ICONTR 

♦ /BUFFeR/IC ♦ TBUF (10240 ) 

♦ /WEDGL /NSTEPS *nOWeG * ITRaNS ( 11) * INT ( 1 1 ) 
logical noweg 

data iCOnTR/200/ 

data SMARG’SLT/3527* *685. *2644* * 2 644 . / , ZEFF /0 *8/ 
data nSTePS/11/* I TR a nS/0 » 100*200 • 300 1 40 0 *500*600* 

♦ 700*800*q00,1000/,lNT/0*100*200*300*400*500*ft00*700* 

♦ 800*900*1000/ 
data noweg/ .true*/ 

END 


switches - /ON 


BLOCK 

data* 0 
film 20 

DEnS 1 

buffer 102ij1 
wedge p4 


length 

( 00000 0 ^ ♦ 
(000050^ 
(000002) 

( 050002) 
(0000^0 ) 


♦ ♦compiler — CORE + * 


PHASE 

liSed 

free 

declaratives 

0036f, 

I3425 

executables 

005/0 

I3221 

assembly 

00860 

1584r 


47 
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0 00 1 
0002 

0003 

0004 

0005 

0006 

0007 

0008 

0009 

0010 
0011 
0012 

0013 

0014 

0015 

0016 

0017 

0018 

0019 

0020 
0021 
0022 

0023 

0024 

0025 

0026 

0027 

0028 

0029 

0030 

0031 


C PASS 3 data from TAPE TO fINAL TAPE FORM 

C THIS program takes A SEQUENCE OF INPUT FILES LaBElED <CHAR>1*DA^B 
C through <CHAR>M.dAT Off Oh tape which has been made by PASS2 

C determines the magnetic fields B* field angles tOAM»pHl), and 

C VELOCITIES V FOR ALL ThE POInTS IN THE REGION* PaSSj STORES THE 

c results of its Analysis in a scratch file until completion of 
C ThE analysis* at completion of The analysis PaSS3 REQUfSTS an out 

C TAPE and after CONTINUATION pUTS ThE dATA ON TAPE. THE FINAL TapE 

C records begin with two key words ICODE and n# icode 

C defines The nature of the record and N ThE length of the BUFFfR to 

c follow* The output records are coded as follows: 

C ICODE=l *Nf IBUF=LABEL OF LENGTH N CHARACTERS. 

C Ic00E=2,NtiBUF (lft2> rXSTEPzSEcONDS oF ARC BETWEEN X STEPS(REAL). 

C iBUFt3g4>rYSTEPrSEcONDS OF ARC BETWEEN y STEPS^REAL)* 

C TBUF ( S ) =NX 'NUMBER OF FIELD UNITS IN X DIMENSION* 

C IBUF =NY::NUMbeR OF FIELD lJNitS IN y DIMENSION* 

C ICOOE=0 *N* iBUF { 1) =IX=X STEP POSiTON OF THIS DATA pOInT* 

C TBUF(2irlY'Y STEP POSITION oF JHIS OaTa POINT. 

C iBUFt3A4)-V-VEL0ClTY aT THIS PO INT < K M/SEC * qOwn > < RE AL ) * 

c ibuf(Ss 6 )=B 2 field strength at this POINTIGaUSS) !real) * 

C tBUf ( 7«8) =GAM=FIELD angle from line of SIGhT tDEGRFES) .'read • 

C IBUFC9R10) rPHiSFlELD ANGLE FROM X SCAN dIReC T lON{ DEGREES M RE aL ) . 

C LaRRY NOVEMBER * 21-AUG*73 
common /ruffer/ibufc ( 51? ) 

dimension lBUF(25fe*2) t I bUf 1<256) *IBUF2( 25ft ) f lEXT <5) * LABEL (32) 
logical ♦! char (2) ,IFIL(10) .IFILnm(4) 

equivalence (IbUFC(I) »IBUF(1<1) mBUFKi) ) * (IRUFC(2*s7) ,IBUF2(1 ) ) » 
+ UFIL(1)*IEXT(1)).(IFIL(3). IFILnM( 1) ) ♦ ( CM aR ( 1 ) * I C H A R ) 

data iEXt/ ! 00 ’ * *00 * ♦ ♦ 00 ‘ ' .O: , ♦ AT !/ ♦ ICHAR/ ♦ 0*/ 

CALL SETfIL ( 2 * *SCRT( H*TMP! ,lERPt«DK ♦ * 0 , 0 ♦•♦23;^ *2 ) 

WRITE (6M 000 ) 

READ(f»»90l) NX, NY 
WRITE (6« 1 00i ) 

REaO.( 6*900) IFlUl) 

Llz0 

1 LirLl+1 

ENCODE (4, 1003» IFILNM) Ll 
DO 3 L2=1 *4 

3 IF ( 1FILNMIL2 ) *E0*CHAR (1 ) ) 1 F ILNM ( L2 ) zC HAR ( 2 > 

call SETfIL( 8*IFIL) 
s continue 

READ(a*END=100,ERRr2«B) KoDE^N* ( IBUF1(L2) *L?=1.N) 

IlrICODE+1 

GO To (l0*20,4i?|) *11 

10 READ(a*END=100 ) ICOOE*N, { IrUF2(L?) *L2=1 *N) 

CALL PRCSS5IBUF*NX*2sTEP) 

GO TO 5 

20 IF(L1.NE.1> GO TO 5 
DO 30 L2rl*N 
30 LAbEL(L2)=IbUFi(L2) 
label ( 32) tN 
GO TO 5 

40 IF(Ll.NE.l) GO TO 5 

CALL SPARM3(IbuF1,NY.XSTEP,YSTEP,2STEP) 

CALL I01(3*IBUF1*NX*NY*IERR) 

kS 
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0032 
\ 0033 

0034 

0035 

0036 

0037 

0038 

0039 
004 0 

0041 

0042 

0043 

0044 

0045 

0046 

0047 

0048 

0049 

0050 

0051 
0 052 

0053 

0054 

0055 

0056 

0057 

0058 

0059 

0060 
0061 
0062 

0063 

0064 


0065 

0066 

0067 

0068 


NXr0 
60 To 5 

100 END FILE 8 
GO TO 1 

200 continue 

DO 210 Ll=lfl0 
call bELL 
DO 2l0 Lp=l*10000 
210 continue 

WRITE (6 » 1002 ) 

PAUSE 1 
iCODErl 
NslABEL { ^2 > 

WRITE (8) ICODE*N» (LABEL (LI) tLlslfNi 
IC0DEr2 
N = 6 

WRITE (8) IC0DE*N*XSTeP»Y 5TEP»NX»NY 
ICODE=0 
N = i.0 

DO 250 Li=1*NY 
DO 250 L2=1*NX 

Call io1(1*ibufi*l2»li*iRec) 

VrFLOATi IBUFI < lREC+1) ^256. 

B=FL0AT ( IBUfI I lREC+2) ) /4. 

GAMxFLOAT < iBUFl ( IREC+3M /l28* 

PHI=FL0AT t IBUFI ( IREC+4 J ) /IpS* 
p50 WRITE(8> IC0DE,N*L2*L1»V*B*GAM*PHI 
END FILE 8 

end file 2 

CALL delete 
Q 00 FORMAT(Al) 

Q0l FORMATd:^) 

1000 format C! specify the maximum number Of PICTURE!, 

♦ * elements in X <CR>,^/ 

♦ ’ and the maximum number OF picture** 

♦ ♦ elements in Y <CR>*/* d3 FORMATS)*!/) 

1001 format(! specify one letter which identifies tape:, 

♦ ♦ input FILES<CR>,’0 

1002 format(* mount tape for output of magnetogRam and assign*/ 

♦ ♦ tape file to unit fi, then Continue*!/) , 

1003 FORMAT (I 4 ) 

END 

routines called: 

SetFIL* PRCSS , SPARM3* lOl , BELL • FLOAT * DELETE 


SWITCHES = /ON 

BLOCK LENGTH 

main* q95 1003706>* 

buffer 5 I? (002000) 

♦ ♦compiler CORE** 

PHASE USED FREE 

DECLARATIVES 0036fe 1^425 
executables 00911 I 2880 
assembly 0l62q ls0?9 


L 9 
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0001 


0002 

0003 

0004 
0 00 5 
0 006 

0007 

0008 

0009 

0010 
0011 
0012 
0013 
0 014 


C 

C 

c 

c 

c 

c 

c 

c 


INPUT 

parameters 


subroutine sPARM3(BUF *NY*X5TEP*YsTEP*ZSTEP) 

SPARM3 interprets THE PARaMETER RECORD ON ThE 
tape and returns to the program The following 
XSTEP^SECONDS of arc per X increment* 

YSTfP=SECONDS of arc per y increment. 

75TeP=mIC0NS wavelength between data points. 
my=total number of steps in y dimension. 
dVEL=KM/SeC per micron wavelength of red ^HIFT- 
dFlh^gauss per micron wavelength oF component shift 
dimension BuF C 4 > ♦ INTG ) 
common /lNPRM/dVEL «dfld *gfac 
equivalence (InTG(1) .REaLX) 

XSTEPrBUF ( 1) 

YSTEPrfiUF <2) 

ZSTEP:BUF<3) 

ZCEN=rUF (4> 

REALXrBUF (5) 

NY=INTG1 t ) 

0VEL=2.9q8E5/ZCEN 

DFLD=2.1u20E10/OFaC/ZCEN*+2 

return 

END 


switches = /ON 


BLOCK length 

SPaPM3 i35 (0004i6)* 

LNPRM fy (0 00014) 


♦♦compiler * 

PHASE 

declaratives 

executables 

assembly 


CORE** 
USED FREE 
0036ft I3425 
0062r l;5l63 
00985 1s723 


50 
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k^002 

t^003 
l!’00 4 
0 00 5 
0 00 6 
000 7 
0008 
0009 
0 011^ 
0 0.U 
0012 

0013 

0014 

0015 

0016 

0017 

0018 
0019 
002 0 
002 1 
0022 
0 02 3 
0 02 4 

0025 

0026 
0027 
0 02 8 
0029 
003i-^ 

0031 

0032 

0033 

0034 
0 0.35 

0036 

0037 

0038 

0039 


subroutine pRCsSllBUFfNX^ZSTEP) 

c prcss determines The field strength* direction* and velocity 

C FROM THE RAW DATA IBUF USiNG T HE ThRFE ROUTINES PaRM*FIeLO, AND 

(; prMFFT* 

dimension PK (2 * 15 ) « IfiUF (25f»*2) tIZ0.^2> *DAT (25t») *iP0L^2) * 

♦ PKHds^ *DATA <256*2 ) 

EQUIVALENCE (IZ0<1)*Z0* 

Common /fIlter/nsamp /fft/noffT*bmin*gbnd 

logical nOFFT 

data nT IME/-17 »NAN6/-1/ 

DO 50 Ll-1*;> 

N2IBUF ( 1 ,L1 ) 

IXriRUF <p*Ll ) 

I Y-IBUF <3*L1 ) 

IZ0<1>=IBUF(4*l1> 

120 <2 ) r I bUF(5*L1 ^ 

IPOL ^LI IzIBUF <6*L1 ) 

DO 10 L2rl*N 
10 DAT ( L2 ) 2 iBUF <Lp+6»Ll ) 

DO 30 L2=1*N 
30 DATA<L2*l 1 >rDAT<L2) 

50 continue 

IF( ( IX.EO.I) *AND* ( IY.EO.D ) NTIME=NT1ME+1 

IF ( ( IX.EO*l> - and* ( lY.EO.l } .AND# <lPOL<l) #LT .256) ) NaN 6 -NAN 0 +i 
IF( <NTIME#LT.0 ) - OR. < (IPoUl ) -LT.pSb) . A nD • ( N A NG -lT • 0 ) ) ) RETURN 
IF(IX.GT.NX) NXrIX 
call t 01{1 MBUF»rX»lY*IRP-C) 

GAM = FlOAT< THUF ( irec + ,^,1) )/i 28. 
pHI-0 . 

call PrMFfTCdATA *N*2STEP*Z0 ♦V»B*OAMfCONlN) 

B=INT<n/l0-> 

B=B+10. ^CONIn/100* 

IIzV+256. 

I2rB+4. 

I 3-G AM + I 28 • 

I4=PHI ♦128# 

IBUF < iREC + 1 *1 ) = <NTIME + IbUF { IReC + 1 *l)+Il)7(NrjMEi^l) 

IF ( I POL (i)*GE*256) IBUF(IREC^2*1) = I2 
65 IF ( JPOH 1 ) •GE *256) I bUF ( I REC ♦’3 » 1 ) = 13 
IF ( TPOL < 1 ) *LT *256) IBUF (IREC*^4»1)- 
+ ( NANGfiBUF I iREC+^*l > +14) /<NANG^1) 

call rOl { 2 * IBUF ’ IX 1 T Y * IREC ) 
return 
End 

routines called: 

loi » float , prmfft* int 

switches = /ON 


BLOCK 


length 

PRCSS 

2244 

( 0 1 0 6 1 0 ^ + 

filter 

1 

<000002) 

FFT 

5 

<0000)2) 


♦+COMPILER — CORE+* 


PHASE USED FREE 

declaratives 00637 1:^154 

executables 0084? 1?944 51 


for Tran 
0001 


0002 

0003 

0004 

0005 

0006 
0007 
000 8 
0009 
00l 0 
K0ll 
0012 
00l 3 

0014 

0015 
00l 6 
0017 
00l 8 

0019 

0020 
0 021 
0022 

0023 

0024 

0025 

0026 

0027 

0028 

0029 

0030 

0031 


V004A 0lj45;24 20-MAR-7u 

subroutine lOi ( mode ♦ IBUF » I X ’ I Y * irec ) 
c 10 Scratch is hanDleo by loi. three mooes 
C reads into IBUF THE REQUESTED COORDINATE IX 
c IS Contained in the four records following 
C IBUF. mO0E=2 writes ON ScRATCH IBUF • MODE 
c To accept ix bY iy elements- 
dimension IbUF(1> 

X = IX 
Y=IY 

GO TO (l00»200. 300) -MODE 
100 continue 

IF((IX.LE*0)«OR.,<IY.lE*0)) return 
RECr lX-1, ) + YDIM + Y 
ISeG=(REC- 1. )/6^*»l- 
IREC2 ( REC -FLOAT < ISEG-1 ? ♦64.*1 . ) +4* 

READt2*ISEG> t I BUF t Ll ) *L 1= 1 »2 b6 ) 

return 

?00 Continue 

IF ( ( IX .LE-0 ) .Or . 5 lY *lE* 0 ) J RETURN 
REC=<X-1. )+YDlM+Y 
ISEG= {REC-1. ) /64« 1 1 . 

WRITE (2 * ISEG ) ( IBUF (Ll ^ »Llrl *256) 

return 

TS00 CONTifjUE 
ydim=y 

RECSX+Y 

ISEG= (REC-*!. ) /^»4- + l- 
define FILE 2( ISEG*256*U*IVAR) 

WRITE (2 * 1 *ERR = 350) IDUMMY 

Return 

:^50 End file 2 
call delete 
WRITE( 6*1000) iREC 
STOP 1 

1000 FORMAT(* ERR:FORT00l00S 12 , * EXECUTION TERM I nA TEO • ♦ ) 

End 

routines called: 

FLOAT * delete 

switches = /ON 

BLOCK length 

lOl 383 (001376)* 

♦♦compiler — CORE** 

PHASE USED free 

declaratives 0036f, 13^2 ^ 
executables 00607 I 3I84 
assembly 01300 ls40fl 


PAGE 1 


are possible* MODEr^k 
tiY data* That datW^ 
the irec element in arh 
=3 initializes the File 
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1 


1.0 001 


0002 
0 00 3 

000 4 
000 5 

0006 


0007 

0008 
000 9 
0010 
0011 

0012 

0013 

0014 

0015 


0016 

001 7 

0018 
0019 
002 0 
0021 
0022 

0023 

0024 

0025 

0026 

0027 

0028 

0029 

0030 

0031 

0032 

0033 

0034 

0035 

0036 
0 03 7 

0038 

0039 
004 ' 

004 1 
0042 
0 04 3 

0044 
0 04 5 
0046 


C 

C 


107 


9 

101 

C 

c 


7 


5 


C ♦ 


SUBROUTINE PrMFfT (DATA. N.ZSTEP.Z 0 .V.B. GAME, COnIN) 

master calling routine for ft analysis of ZEEMAN PROFS 
needs CONCEN *ZER ’POLYAn 
dimension DATA. 1512 ) 
dimension G 0 LD 12 * 9 ) 

COMMON /LNPRM/D\/EL<DFLD*GFaC 

COMMON /RESETS/ XI * C 0 SGAM*G AM » Slope ft zero tNoR AT* 

I pLCoP < S ) * ACOF *BCOF *CCOF * ALOR 

COMMON /Stuff /CO NT ( 4 } tNCoNT ( 4 ) tCOMT l 2 > *ISTART( 4 ) « 

1 iEND( 4 ) * 5 UM(l 40 ) ,PhD*dELNC*SHIFT*nSHIFT,SCHIFF* 

? nCEnT*lCEnT *SCALE»P* 0 *LIMIT «AREA 
data DOPVeL/ 0 ./ 

Format S* n* p* q !*I 4 , 2 fi 0 * 4 ^ 


DO q I-1»N 
J= I +25ft 

data < Jl =1024.*‘DATA ( 
OATA(I)=1024.-DaTA(I> 

CONTINUE 

fORmAT ( * **l0Fl0*0) 

M3-256+N 

PRInT 101* IdATA ( I 1 * I = 1*N ) 
print 101, toATAH) *I=257*M3) 
DO 7 Irl*2 
DO 7 J=l*9 
GOLD ( I .0 ^ =0 • 


v = 0 • 

LCEnT - 0 
NSHlFT = 25f, 

NCEnT=Z0+0.5+DOPVEL 
DOPvEL=0 • 

P-0.05+ ( data (7> -data iNCENl) ) 

Qsl.l^P 

ISTaRT ( 1 > zZ0/2*^l 
ISTaRT { 2)= (NfZ0)/2-l 

l5TART(3)iISTART (1)+256 

lSTART{4i zISTART(2) +256 

lEND U) =6 

IEND I 2) =N-5 

lENO < 3) =2^2 

lENDl 4) =251+N 

call CoNTmA f data *N) 

continue 

COMT ( 1 ) -AM A X 1 ( CONT ( 1 ^ * C OnT ^ 2 ) ^ 

conin^comi ( 1 ) 

cOMT (2 ) =AMAXi (C0NT{3) *COnT54) ) 

♦♦+tFuDGE To Throw out underexposed frames 

DEXP = 110* ^ « Vr, 

lFlABS(C0MT(2)“DATAtNC8NT+NSHIFTM .LE*OEXP) 

1 GO TO 1054 
M20 

DO 2l j=1*257*2b6 


M = M il 
m3=j+N-1 
DO 21 L=J*M3 

21 OATA ( L 1 zCOMT (M J-DATA ^L J 
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2 


0047 


DMAx1=0 • 

0048 


M5-nC0nT ( 1 ) 

0049 


m15>=NC0NT (2) 

0050 


DO 2300 IrM5,Ml5 

0051 


IF (data ( I ) .LE -DMAXi ) gO TO 2300 

0052 


mmi-i 

0053 


dmaxj =dATA ( I \ 

0054 

2300 

continue 

0055 


DMAX1=o 5UM (MMl*2 *Mm1 ^2*DATA ) 

0 05 6 


DMAX2 = 0 * 

0057 


M5^NC Out ( 3 ) 

0058 


Mi5=NC0NT (4) 

0059 


DO 2301 I=M5,Ml8 

006 0 


IF (data ( n -LE-D mAX2) gO tO 2301 

0061 


mmi=i 

0062 


DMAX2=DATA ( I ) 

0063 

2301 

continue 

0064 


DMAx2=nSUM(MMl*2»MMl+2*0ATA ) 

0065 


P= ALOG ( DMAX2) /AL0G(DMaX1 ) 

0066 


IF ( aBS( 1--P) ,GE,0-3 0> GO TO 2305 

0067 


DO 230p I=l*?56 

0068 

2302 

DAT A ( n = ABS (data ( I) ) **P 

0069 


GO TO 2307 

0070 

2305 

print 230f>*P 

0071 

2306 

format P wrong »Fl0.2) 

0072 

230? 

continue 

0073 


call COMBIN (data *N) 

0074 


DOP\/EL = LCENT>PHO-20 


C fudge factor for 3p micron data PTS...5250 

0075 


V=0.25?8+DOPvEl 

0076 


LA^I CEnT*nCOmT.(1 ) 

0077 


LB=I AR9 INCONT (2) -^LcENT) 

0078 


lc=lcent»-nShift-ncont(3) 

0079 


lDSI ABS(NC0NT(^) -LCENT-NSHIFTJ 

0080 


LlMrMIrsl0 (lA *LB *69)-1 

0081 


DO 10 kMOdE-i »2 

0082 


LlMlT=LlM-l 

0083 


n0ri6=limit+i 

0084 

10U 

format ( ! * *716) 

0085 


do q64 L=1*LIMIT 

0086 


5UM (NOrIG + L) =OATA .(lCENT+L) 

0087 

96a 

SUM (NORIG-L) rDATA IlCEnT-"L) 

0088 


SUM (NOrIG ) rOATA (LCENTl 

0089 


call Poly an ( sUMt 14 at noRIg* limit »phd*kmode) 


C 

♦♦♦fudge factor for 32 MICRON INTERVAL 5250 ♦♦♦ 

0090 


G0LD(Km0DE*4) =SlOPE+1i3-q2 

0091 


IF ( rZERO«EQ*0 ) GO TO 71 

0092 


gOld(kmode *1) =xi 

0093 


GOLD (KmODE *2 ) =X1+1i3*q2 

0094 


IF(nORaT.nE- 0 ) GO TO 7l 

0095 


GOLD (KmODE *3 ) =C0SGAM 

0096 


gold (KmOOe *5 ) =cosgam*gold (kmode *2 ) 

0097 


GOLD (KmODE * 6) rPLCOF (2) 

0098 


60LD(Km 0DE*7)2 (ABS(PLCOF(3n f ABS(pLCOF(4 ) ) + ABS (PLCOF ( 5 ) ) ) 


1 *0*33 3^3/ aBS(PLcOF(2) ) 

iFtABS(COSGAM) •lT.h.Z) GO TO ~f\ 

5 ^ 


0099 
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&100 

i101 


0102 


0103 

0104 

7l 

0105 

0106 

10 

0107 

C 


c 

0108 
0 109 

10S4 

011 M 

100 

0111 

0112 



CGM=GOLD !kMODE *4 ) /GOLD t Km 00E*2 ) 
r Oi n ( K mODL * 3 ) — 0 • 3 3* COSO AM + 0 * 67 ♦CGM 

G01:d(Km0DE.5)=G0LD(KM0DE.3»*60lDIKM0DE-2) 

continue 

LCEnTslCEnT +nSHIFT 

LlMrMIN0 ^LC »lD »69 J -1 
continue 

LCEnT=lCEnT-2+NSHIfT 

PRInT i0 0,NCONT*CONT *LCENT*DOPvEL*V* 

( (G0LD( = *1 = 1*2) 

continue 

call BGOOD tOOED*B *GAMF ) 

FORmAK •0»4IS***F10.1/’ lCENT* DOPVEL* V 
l4*pFl0-3/t» *3 f10.I*'^F1c^.3)//) 

return 

end 


routines called: 

COnTNA» aMAXI * AB^ ’ DSUM 
MIN0 * POLYAN, BgOOD 


aLOG * COMBIN* IAB8 


Switches = /on 


BLOCK 


LEnOTH 

prmfft 

1532 

( 005770 ^ * 

lnpRm 


t 0000 1 4 > 

RESLTS 

28 

1 000070 ^ 

stuff 

324 

(00l2i0i 

4*compileR - 

CORE** 


PHASE used free 
declaratives 00823 lp96B 
executables 01247 1^^544 
assembly 0p067 14641 
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1 


0001 SUBROUTINE” CoNTnA I DA TA » NPTS ) 

C FINDS CONTiNUA AT NCONT ^ I ) ♦ CONT INT ^ COnT.^I) 

c istarTU) contains indices OF First pt. tested, iend^^)* last 

c P IS MAX* allowed EXPOSURE CHANGE aT +-2 PTS.FROM PY* TfSteD- 
c 0* likewise at PTS. AWAY. 

C modified 1/25/74 CONT(I> FOUND BY LOOKING FOR FLaTNESS 

C NCONTtI) FROM MAX* SIGNAL N£AR FRAmE EDGE 

c needs fcn. DSUM 

C T. TaRBFLL JULY 12*197l* 


0002 


0003 

0004 

0005 
0 00 6 

000 7 
0008 
0009 
00lH 
0011 
0012 

001 3 

0014 

0015 

0016 

0017 

0018 

0019 

0020 
0021 
0022 

0023 

0024 

0025 

0026 

002 7 
0028 

0029 

0030 

0031 

0032 

0033 

0034 

0035 

0036 

0037 

0038 

0039 

0040 

0041 

0042 
004 3 
0044 


COMMON /STUFF/C 0 NT( 4 > *NC 0 NT( 4 » »C 0 MTI;>) *iSTART( 4 ) * 

1 tend ( 4) »SuMl70J fDlT^/0) ’PHDfDELNC tSH I FT * NShI FT * ScH ipE * 

2 nCEnt^lcent *scale*p*q*limit* area 
dimension 0 ATA< 512 ) 

DIF {MfN>-ABS(DATA ImJ *DATA <M^.N) ) 

UO 10 I~l,4 
J=ISTART ( I ) 

K = i 

IF((I.EQ.li.0R.U.E0.3)) Kr*-1 
CTEMPrl00* 

NTeMP=0 

1 J=J+K 

IF( ( t I-EQ.l) *0R.5l*E0*:i) ) *AN0. ( J.LE.IENDI I ) )) GO To ll 

if((M*eq.2).or*!i*eq.4))*and.(j.oe,ienD5i)>) go to ll 

A=DIF ( J*p) 

IF(A*GT*P) go to 1 
B=dIF ( J*- 2 > 

IF(B*6T.p> GO TO l 
C-DIF< J*a> 

IF(C*gT*q) go to 2 
D = DIF { J »-4 J 
IF(D*gT.q) gO to 2 
NCONT ( I ) rU 

COnT I I ) =dSUM( J- 4 * J + 4 ,DaTA) / 9 * 

GO TO 10 

2 C = aMAXKA*B) 

IF (NTEmp*EQ.0) go TO 3 

IF { (C-CTeMP) ,GT*:5. ) GO TO i 

lF(nATA U) .LT.D aTA(NTEMP) ) gO TO 1 

3 CTEMP-C 
NTEMP = J 
GO TO 1 

11 IF (NTEMp.GT.0) GO To l2 

NCONT (I ) -0 

COnT I I) = 0 .0 
GO To 10 

12 NCONT ( I )=NTEMP 

CONT .t I ) =DSUMtNTEMP-*2*NTEMP + 2»DATA ) ^5 • 

10 continue 

L1=NCEnT/4+1 

L2 = 3* tNPTS*^NCENT)/4 + NCENT^l 

np=npts-i 

M 3 =n 5 HiFT +1 

DO 30 J= 1 ,M 3 ,NShIFT 

Ll=Ll+J-l 
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L2=L2+J-1 

0 «4 6 


NP=nP+J*1 

0C14 7 


k1=J+2 

0d48 


K2=nP 

0049 


Tl=0* 

0 05 0 


T2 = 0 . 

0051 

20 

iF(dATa<K1) -lT-TI) go To 22 

0052 


Nl=Kl 

0053 


T1=DATa tKl ) 

0054 

22 

lF.^DATAtK2) •LT«T2) GO TO 23 

0055 


N22k2 

0056 


T2=DATA lK2 ) 

0057 

23 

K 1 1 ♦ 1 

0058 


K2=k2-*1 

0059 


IF t {Kl.GT *L1 ) -and. (K2.LT.L2) ) gO TO 24 

0060 


IFIK1*GT.L1) KlzLl 

0061 


IF(k2*lT.l2) K2-L2 

0062 


GO TO 20 

0063 

24 

IF1j*GT*1) GO To 2b 

0064 


nCOmT 1 1 ) =Nl 

0065 


NCOfiT (2 J -n2 

0 066 


iFt (CONTt 1 ) .nE*0#) .OR. (CoNT(2) .NE.0M J GO TO 30 

0067 


CONT U) r0,333 + .^DATa <Wl ) +DATa (Nl -1) +0ATA (Nlf 1> ) 

0068 


COnT ( 2)r0.333+ ‘DATA<N2)+DATA (N2-1) +DATA(N2+1> ) 

0069 


gO to 30 

0070 

25 

NCOnT ( 3 ) =N1 

0071 


NCOuT { 4 ) =N2 

0072 


IFI (C0NTt3) -NE«0* > .OR. (C0NT(4) .NE.0.) ) gO TO 30 

0073 


CONT(3)=0.333+(DATAtNl)^DATAtNl-l)^DATA(Nl+l>) 

0074 


CONT (4) = 0 . 333 + 5D AT A < N2 ) +DAT A ( N 2 -I ) +DATa ( N2+ 1 > ) 

0075 

30 

CONTINUE 

0076 


Return 

0077 


END 


routines called: 


abs 

* dSum « AMAXi 


switches = /ON 


BLOCK 

length 


COnTNA 

-j 00g ( 0 037u2 ^ + 


stuff 

324 (001210) 


♦ ♦compiler CORE** 


PHASE USED free 


DECLARATIVES 0071u 1^077 


executables 0092? I 2864 


assembly 0i54*s 1s163 
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1 


«001 


0002 
000 3 
0004 


0 005 
0006 
000 7 
0 00 8 

0009 

0010 
0011 
0012 

0013 

0014 

0015 

0016 

0017 

0018 
0019 
0 0?0 
0 021 
0022 

0023 

0024 

0025 

0026 

0027 

0028 

0029 

0030 

0031 

0032 

0033 

0034 

0035 
0056 

0037 

0038 

0039 
0 04 ‘'i 
0 041 
0042 
004 3 
0 044 

0045 

0046 


subroutine CoWBlN ( dATA *NPTS1 

c FiNns central wavelength or profile using zeroth and 

c first wOMENTS Of both POLAP iZatIOnS 

c center is at k^phd 

c TOT 1/17/74 

dimension DATA.1512) 

EOUIVAiENcE (K*LCENT> 

COMMON /STUFF /COnT I4 > ♦NCONT I4 ) *C 0 MT ( 2 ) ♦ I START t 4 ) * 

1 lENO(4)»SuMt70)*DlFl/0j *pHD *DELNC * 5H IFT * NS HI FT * 

? SCHlFF,NCENT ,LCENT , SC aLE * P * Gi *L IM I T » ARE A 
ST =0* 

NIT-0 

NPTzNPTS+nSHIFT 

PHD=0- 

1 nIt=nit+t 

LA = NCEmT“nCOnT( 1 ) 

LBSI ABS INCEmT“NCONT t2) ) 

LC-iABS(NcENT-NPTS+1 > 

LIM-MIn0.^LA*lB»lC)-2 

W=0.1/fLOaT<LIM) 

AM0rCOsTR{DATA*sl2*NCENT*LlM»W*ST,PHD*I) 

AM1=ST/W 

nCEN=NCENT+NSHIfT 
LA=nCEn-NcOnT (3) 

LB = I ABS < NCEN-NCONT ( 4 ) ) 
l.lMrMlN0^LA*l B*LC)-2 
W=0.1/FLOaT (lIM) 

BMBzCOSTR (DATA *5l2tNCEN*LlM,W»ST ’PHD • 1 J 
IF(aBS( AM0-BM0> .GT.3000. ) GO To ll 
BMlrST/W 

DElnC=0 *5* (BM17bM0 + AM1/ AM0 ^ 
cEna=ncEnt^-phd 

CENsCENA+dELnC 

10 format (’ old* new centers *2F10*2) 
test =CENA + 0«?5 

IF( aBS(DELNC) *GT.TeST) go to 20 
lpiNlT.GT.10) 60 TO 20 
NCENT3c£Nf0»5 

k=ncent 

PHDrCEN-FLOAT (NCENT) 

WRITERS *169) AM0*BM0 *dELNC * CEN A *CeN » l IM 
lf>9 format (2F20‘5*3f7*3*I10) 

WRITE (6*Tg9) AM0 *BM0 ♦dELNC *cENA *CEN *lIM 
I FI ( ARS^ DELNC )»LT*0.05)*ANO.(NIT*g‘<«1 )) RETURN 
GO TO 1 

20 print ll 

11 format (! SLOW convergence in combine*) 

CEN-CENA+0 .S+DElNC 

K=CEN+0*5 

PH0=CEN*FL0AT<K) 

return 

END 


routines called? 

IABS • MlN0 • float ♦ COSTR f ABS 


switches = /on 
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length 



FORTRAN 

V004A 

0001 

function dsum rN 

1 

C T. TARBELL JULY 

0002 

dimension DATA 

0003 

SUM=0.0 

0 00 4 

if(M*lt*n> go to 

0005 

IF { (n.LE*0 ) •OR. 

0006 

IF t iM .LE *0 ) *OR • 

000 7 

DO 1 T=N.M 

0008 

1 SUm=SUM+dATA (I ) 

0009 

OSUM=SuM 

00i ;-i 

return 

00ii 

2 OSUM=0. 

0012 

return 

0013 

end 


switches s /on 


00:03:46 


l2* l97i 


5N.GT *512) ) 
tM*GT*5l2) ) 


01-JAN-72 


GO TO 2 
GO TO 2 


hlock length 

DSUM 140 ( 0004 :^ 0 ) + 

♦ ♦compiler — CORE** 
PHASE USED FREE 

OECLARATlVE<i 0036^ 1:^42 b 
executables 00S27 13264 

assembly 009Br 1b720 


page 1 
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1 


0001 


SUBROUT InE ZER (DAT »N*NC *L IMIT tSLOP*wNEw tpHD ♦ IZERO twCOS ) 


c 

2eR returns the first positive zero of the sine transform Oh da 


C 

USES method Of false Position with 5 iterations 


c 

wnEw is value of Trans, variable at zero. iZero=0 if no zero f 


c 

origin iS at nc * endpoints Nc+LiMIT »nc-limit . length is n 


c 

SlOPF is ThE sin TRaNS. at W = ,1/lIMIT PHD is phase factor 


C 

IF NCOS LE 0» finds 1ST 2 ROOTS OF COS TRANS^ 


C 

SLOpE=SMALLER root, WNEW = larger ROOT 


C 

T. TaRBELL JULy i^2» ^9l\ 

0002 


dimension DaT(n) 

0003 


SLOP=0 . 

0004 


wNEw=0* 

0 00 5 


if InCOS«LE-0) go to 

0006 


W220-1/FlOAT(LIMIT) 

0007 


A = c0 STR (DAT»N»nC »LIMIT* W2 * GlOP , PHn *NCO s ) 

0008 


SLOP=SlOP/ ( A+W2) 

0009 

4 1 

continue 

0 01-^ 


w2*0* 075 

0011 


TEMI =TrAN1 (DaT’N*NC »LIMIT»W2*PhD*NC0S> 

0012 


Wl = ^2 

0 01 3 


S1::SIgN( 1 • »TEMl ) 

00 


TEM2=0. 

0 0lb 

1 

W2rW2+0.025 

0016 


1F(W2.GE.10 go to 4 

0017 


TEM2 = TRAn1 IdAT,N*nC *L1MIT*w2*PHd»NC05) 

0018 


S2rS I gN 1 1 • »TEM2 ) 

0019 


IF(S1.NE.S2) go to 20 

0020 


TEmI =TEM2 

0021 


SlrS2 

0022 


Wlrw2 

0023 


GO To 1 

0024 

4 

continue 

0025 


PRINT 100 

0026 

100 

FORMAT NO ZERO FOUND* * 

0027 


IZEROr0 

0028 


return 

0029 

20 

continue 

003f^ 


TnEW=0 • 

00-31 


ITER = 0 

0032 

21 

ITER = iTER+ 1 

0 03 3 


WNEW=wl- { W2-W1) +TEM1/ ( TEM2-TEM1 ) 

0034 


IF ( 1 TER.GT.4) go to 30 

0035 


TNEW = TrAN 1(DAT>N»NC ’LIMIT »WNEW,PHD tNCOS) 

0036 


SNFW^SIGn ( 1 • *TnEW) 

0 03 7 


IF ( SNEW*fQ*S1 ) GO TO 2? 

0038 


S2iSNEW 

0039 


TEM2-TNEW 

0 0 4 0 


W2zWNEW 

004 1 


GO To 21 

0042 

22 

si^snew 

004 3 


TEm1=TNEW 

0 04 4 


WlrWNEW 

0045 


GO TO 21 

0046 

30 

continue 

0047 


if(ncos*6t*0 ) return 



OUNC 


6o 



Fortran v0pj4a 
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2 


04 8 
049 

M052 

«053 

«054 

8035 

8^56 

8«57 



IF .lSLOP^*NE -0. ) return 

«^LOP=WNEw 

w1=amax 1 t Wl »w2) 

IFIw1*nE»W2) go to 43 
Sl=52 
TEMI =TeM2 
GO TO 1 
43 w2 = »n'1 

GO TO 1 

end 

routines called: 

float 1 COSTR ♦ IRANI » SIGN ♦ AMAXI 
switches r /ON 

BLOCK length 

ZER (0023i6> + 

♦ ♦COMPILER CORE** 

phaSe used free 

declaratives 0fl36fe 1^^425 
EXECUTAblES 00687 I 3 I 84 
assembly 0l36a 1^344 
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1 


0001 


0002 

0003 

0004 
000 5 
0 00 6 
0007 
000 6 

0009 

0010 
0011 
0012 

0013 

0014 

0015 

0016 

0017 

0018 

0019 

0020 
0021 
0022 

0023 

0024 

0025 

0026 

0027 

0028 

0029 

0030 
0 0 31 

0032 

0033 

0034 

0035 

0036 

003 7 

0038 

0039 

004 0 

0041 

0042 

0043 

0044 

0045 


C 

C 

C 

C 

C 

C 

c 


3 

1 


2 


10 

11 


function costr (Data *n*nc ♦limit *w, si ntr,phd*ncos) 
returns The CoSInE transform KoSTr) aNO sine transform (SINTF^i 
USES SI NCOS recursion FORMULAS FOR SPEED. NOT aN fFT. DONT INvI 
data is The array of dimension N» wITh origin at nc and endpoints 
at +-LImIT. w is value of transform variable. +SIn(W*X) is used 
the transform is then shifted In phase by -PHO 


tarbell July 22* 197I 

IF NCOS NEG«, C05TR=SIN- TRaN 
dimension DATA(N) 
ct=data (nC ) 
if(W»eQ*0*^ go To 10 
ST 30 • 

CTEM=1.0 


SINTR-COS- TRAn 


STEM=0. 

COSW = COS(W i 

C0SW2=2.*C0SW 

SInW=SIN(W) 

DO 1 1=1, limit 


J=nc+i 

K=nC*I 

CTrCr fCOSW^ (DATA5 J)+DATa (K) ) 

STrST^ SINW+ ( 0 AT A 5 J ) -DAT A t K ) ) 

H2COSw2*cOSw-CTEM 

CTEM^rOSw 

COSW=H 

H=C0SW2+sINW-StEm 

STeM=SINW 

SlNW=H 

continue 

IF(PHD,NE*0. ) GO tO 2 

SInTRzST 

COSTRrCT 

IF(nCOS*GE*0)RETURn 

T=SiNTr 

SINTR2C0STR 

COSTR2T 

return 

PHrPHD+W 
CPh=CoS ( pH J 
SPhtSIN ( pH) 
SInTR^CPh+ST-SpH+cT 

COSTRzCPH+CT+SpH+ST 

return 

do 11 1=1 tLlMlT 

CT = t T+OATA (nC + I ) ^DATA (NC-I ) 

COSTRzCT 

SInTR=0. 

IF(nCOs*GE.0) return 

S1NTR=cOSTR 

COSTR=0- 

return 

end 


routines called: 
cos ♦ SiN 

SWITCHES = /ON 


Block 


length 
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01 
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1 


t300l 


function TRANI 5dATA *N fNC *limit 


C 

same aS costR* but computes only 


C 

trani = SIN. Tran, if ncos.gt.0 


c 

= cos. TRAN. IF NCOS.LE.0 


c 

TDT 4/5/74 

•»002 


dimension DaTA(N) 

0003 


lFtNCOs*LE.0) GO TO 200 

0004 


PH3w*PhD 

0005 


STEM=*SIN(PH) 

0006 


ST=DATa (nc) *STEM 

0007 


COSW = COS Lw ) 

000 8 


SlNW^SlN ( w ) 

0009 


C0Sw 2=2 • *cOSw 

0010 


DO 100 I=1»LIMIT 

0011 


j:nc* I 

0012 


KFNC-I 

0 013 


ST=sT+sINW* ^dATA U) -DaTA (K) ) 

0014 


H=CoSW?+SINW-STeM 

0015 


STEM=SINW 

0016 


SlNW=H 

0017 

100 

continue 

00l 8 


TRAN1=ST 

0019 


return 

0020 

200 

continue 


C 

COS* tRan* part not needed yet 

0021 


tRani=0 • 

0022 


return 

0023 


end 


Routines called: 


SIN 

• cos 


switches = /ON 


block 

length 


TRaNI 

?63 (00l0l6)* 


♦♦compiler CORE** 


PHASE USED free 


declaratives 00448 1^345 


executables 00607 I3I84 


assembly 01084 1s624 


W* PHD* NCOS) 
ONE transform 
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1 


0 1 


0002 
000 3 

0004 

0005 


0006 

0007 

0^108 

0(^09 

0010 

0011 

0012 

0013 

0014 

0015 
0 0l6 

0017 

0018 

0019 

0020 
0021 
0022 

0023 

0024 

0025 

0026 

0027 

0028 
0 02 9 

0030 

0031 

0032 

0033 

0034 


l 0 

9q 

^00 


SUBROUTINE PoLY AN I oA T A . N , NC , L IM IT . PHD »K MOD E » 

OVERSEES FOHRlER TRANSFORM AND lEO* PO ♦ 
akiAI vSTC of circular POARiZATIONS 

aIs(COSgAm] GT 0.7* ALSO USES SEARS RELS. ON B/U-C) 
nlMFNSlON DATA.tN) *TX.^9) *GPT(5) *PLC0F ( 5 > ♦GWT <5 , 5) ♦SPTl^) 

common/reslts/x»cosgam*gam*slope*iZero*norat* 

D AT A^SpT/ 1 .0,0*9l3q0 *0.67095 *0.314 90*0*/ 

data NgPT/4/,GPT/1. 5708*1.1529, 0.7355*0. 3204* 

/ riiiT/ 2089795 q* 0 .* ** 52244898 * 0 *. * 705 ;^ 06 i 2 

la oIzIHaI. -.2RKI4505* -.S9022<t08. -2130132R* 
‘aUUSAl* .22712270. ..0<,09««6 s. -.4s8M118b. 
*B6u74?48. .i84342b1* .2755468a. .32346645. .31877 04* 

5+0./ -»c:/ 

data pi/3. 14159265/. RAD/57 . 295b/ 

AC0S(T)=ASIN(SQRT«1.-Y*T| t 

C ALl°ZER (data. N.NC. limit, SLOPE. WNEW. PHD. IZERO. l I 

IF (kMOOE-EG* 1 ^ SLOPE=*SLoPE 
iF ( iZErO .EQ.0 > RETURN 
X=PI /wnEw 

?^lM^RA^;DArA.N.NCLlMIT.PHD.GPT,MI.SPT(M,.X.NORAT, 

IF InORaT *NE.0> RETURN 

continue 
DO ll M=2,NGPT 

r k y -»P T _GPT ( M J , 

TX JIM + NGPT-'.I) ^RAT^DaTA fN»NC *LIMIT *pHO *CKX *SpT . M) 

L *XiNORAT) 

IF InOR aT *NE. 0 ) RETURN 
CONTINUE 

call plInt(Tx*plcof*ngpt,gwt) 
pACr 1 • / ^ PLCOF 1 1 ) +PlCOF t2 i ) 

BsPLCOf ( 1 ) *FAC 

A=0.5+ ( I.+PLcOF (2) ) *FAC 

C=A*FAC ^ 

IFUBS(PLC0F(2) ) .GT.l. J GO TO ll0 

cosgam=i* + signU. »plcof ^ 

C0SGAMlpLcOF(2.*SIGNtl..PLC0F.(2*'.SQRT,lpLCOF«2)*PLC0Fi2) 

1 -1 * i 

iF ( kmode.eQ* 1 ^ cOSgamz-coSgam 
CONTINUE 
RETURN 
END 


Routines called: 
ASIN * SORT » ZER 


RAT 


PLInT « AsS 


Sign 


Switches = /On 

BLOCK length 

POLYAN 623 (002336>* 

RESLTS 28 ( 000070 J 


♦ ♦compiler --*--** CORE** 
Phase used free 
declaratives 00366 1^425 
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0002 
000 3 

0 00 4 

0005 

0006 
0pi0 7 
0008 
0009 

001 

0 0l 1 
0012 
0013 

001 4 
0015 


10 


function raT.DATA.N.NC. limit, PHD-PHAS.SKX.X.NORAT) 

rat = GiNtKX) ♦ COSINE TRaNS(K) / SIN TRaNS(KJ 
Should look like ci + c2 ♦ coS(kx) 
noRat*ne*0 if infinity encountered 
dimension DATAIn) 
data SmALl/T.E*4/ 

NORaT=0 

CT = f OS tR IqATa *N*NC *LImIT ,W*ST*PHd.1 > 

SMAL = SmALL + ab 5 t cT ) 

IFMBS(ST) .GT*SMAU go To 10 

nORaT*10 

RAT:1* 

return 

continue 

rATtCT icSkX/ST 

return 

END 


routines called: 
costr * abs 


switches 2 /ON 


BLOCK length 

RAT 183 I0005s6>+ 


♦♦compiler — 

PHA5E 

declaratives 

executables 

assembly 


CORE** 
USED FREE 
0036^, 1:^425 
00607 1:^184 
01020 ls68fl 
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1 


0001 


subroutine plInt t TX^P lCOF *NgPT ,gwt ) 


C 

PLCOF5nLEg) r CoEFf. of (NLEG-DTH LEGENDRE 


c 

expansion of tX^cOSkX) 


c 

GAUSSIAN OuAD. 2*NgPT- 1 pTS. 

0002 


DIMENSION TX(9) ,PLC0F ( 5 ) ,GWT ( 5, 5^ 

0003 


DO 10 NLEG=lt5 

0004 


SUMc0 • 

0005 


DO 1 Iz1*NGPT 

0006 

1 

SUM=SUM*TX(I)*GwT (nLEG* I ) 

0007 


SGNrl • 

0008 


iFl (NLEG*eO*p) - or* (NLeG*LQ*4) > SGN^*"! • 

0009 


NLrMGPT+1 

00l 0 


nu=nGpt*ngpt-i 

001 1 


dO 2 liNL.NU 

0012 

2 

SUMrSUM*SGN*TX < I ) +6WT (NLEG* i-NGPT + 1 ) 

0013 

10 

plcoF(nleg)=sum 

00l*+ 


return 

0015 


end 


Switches = /on 

BLOCK length 

PLiNT 2l^ (0006 r4)+ 

♦♦COMPILER ----- CORE** 
PHASE USEn FREE 

Declaratives 00^4^ 1.^345 
executables 00527 I3264 
assembly 01044 1s664 
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1 


«0l 

(902 
( 90 ^ 
0004 
000 5 
0006 

000 7 
0008 
0009 
0 010 
0011 
0012 

0013 

0014 

0015 

0016 

001 7 
0018 

0019 

0020 
0021 
0022 
0023 
0 02 4 

0025 

0026 

0027 

0028 
0029 
003 

0031 

0032 

0033 

0034 

0035 
0 036 

0037 

0038 

0039 
0 04 0 



SUBROUtINF B600D ( gold *B *GAMF ) 
dimension G0LDi2*8) 

data DXMAX *DmMAX*RESMAX *AVMlN/.25t • I 5 * • 1 5 * i 50 . / 

PERCEN{ X •Y ) =?.*AB5(X-Y) / {X+Y+I.E-4 ) 

ACOStY ) =ASIN(SQRT ( i.-Y+Y) ) 

DATA PI *RaD/3 • 1-415q27 *57.2958/ 

DM=pERcEN(GOlDU *4) fG0LD(2*4) > 

IF (dM.GT * nMMAX » GO TO 100 
AVMOM = 0 -5 + (GOLD ( 1 *4 ) ^'GOLD ( 2,4 J ) 
lFiABS( AVMOM) .LT* AVMIN) gO tO i0l 
lLOOK=l 

IF,IgOLD^2,7) .GT.RESMAX) GO TO 5® 

IL00K=? 

IF(gOLdU,7) .GT.RESMAX) gO TO f,0 
GO TO 5 I 

50 IF(gOLD(1*7) .lt.resmax) GO TO g0 

51 Wl = l ./PERCEN (GOLD 1 1 *4 ) »goLD ( 1*5 ) > 

W2 = 1./pERCEN(G0l0(2*4) »G0LD{2*5> > 

T:l./twl+W2) 

Wl^Wl *^T 
W 2 « W 2 T 

B = W1 ♦ GOLO ( 1 > +w2*GOLD ^ 2,2 J 
CGAmF = w1*gOLDU*3) +W2*GOlD52»3) 

GAmF=AC0S(C6aMF) 

I F ( cGAmF *LE • 0 • ^ G AMF-P I -GAMF 

gamf~gamf*rad 

return 

60 B=G0LD( IL00K,2» 

GAMF=ACOS(GOLD(ILOoK*3) > 

IF (gOLD< IlOOK * 3) *LE* 0 . > GAMF“PI*GaMF 
GAMF=GAMF+RAD 

return 

100 B=0« 

GAMF=0 . 

return 

101 B=AB5(AVM0M) 

GAMF=0 . 

IF ( aVMoM«lE • 0 • J 6AMF=180. 

return 

END 

routines called: 

AR5 * ASIN 9 SORT 


switches = /ON 

BLOCK length 

BGoOD 594 ( 002244) ♦ 

♦ ♦compiler CORE** 

PHASE USED FREE 

DECLARATIVES 0036f, 1^425 
executables 00687 I3I04 
assembly 01264 I5444 
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C 


program MGRAM 


C 


reads PASS3 OUTPUT TAPE AND PRINTS MAPS OF RESULTS 


C 


needs subroutines pack* PMAPS 


c 


handles any no* pts* on sun. printed out in blocks 


c 


OF NMAX**.T0 change NMAX. change DiM.fEQ* A DaTA 


c 


statements for R* B* V* gam, and nMax 


c 


TDT APRIL 5, lg74 

0001 



dimension IFIL.(5) *R {^500) * B ( 1^0 0 ) *G A M ( 1 500 > ♦ V < ls00 ) * 



1 

title 1^*5) 

0002 



common IDaTA( 100) *MAPSt5) *DELX,DELY 

0003 



equivalence (B!i)*R( 1) ) *(GAM<1) *R(l50lM .(v(l) » 



1 

r(3001) ) * (X5tEP,IDaTA (1 ) ) * < YSTEP * IDA TA ^3 ) U (NX* 



2 

IDATA(s) >.(NY*IDATa^5)) 

000 4 



data R/4500+0./.NMAX/1500/ 

0005 



DATa iblank/. */ 

0006 



data TiTLE/’B !.2+* ♦♦’gA%*M ’♦* «*!v *,2+* ♦* 



1 

»CO»*’nT*.» ♦ ♦ *BV» * 'ER* , ’T V 

0007 

5 


write (6*10l0) 

0008 

1010 


FORmAT(* type filename CR to ABORTV) 

0009 



read tf>*l0ll) IFIL 

00l 0 

1011 


format (5a2) 

0011 



IF(iFIlU) *EQ*IbLANK) go to 200 

0012 



WRITE (6*700) 

0013 

700 


eormat(/! Which maps shall mouse print?*/ 



1 

♦ TYPE 1 FOR YES* 0 FoR NO (H FORMAT)*/) 

0014 



DO 710 1=1.5 

0015 



WRITE (6*701) <TlTL£t J*I ) *J = 1*:^ ) 

0016 

701 


F0RMAT(/* »3A2/) 

0017 



REAO(6,70?) mAPSH) 

0018 

70? 


FORmAT( 11) 

0019 

7l0 


continue 

0020 



call PfEED(0) 

0021 



print 10l2*IFlL 

0022 

10l2 


format (//♦ Filename *,5a2//) 

0023 



call SETFlL(a* IFIL) 

0024 

1 


rEAD{8,END = 100) I code. M 3, ( I DAT A < Ml 3) . Ml3 = l , M3 > 

0025 

2 


ICOdE=tCOoE+1 

0026 



GO TO (50.10,2iM ICODE 

0027 

10 


print 1000. ( iDATAtM) *Mrl,M3) 

0028 



write If,. 10 00) llDATA^M) *m = 1.M3) 

0029 

1000 


FORMAT (500A?) 

0030 



GO TO 1 

0031 

20 


nxtot=nx 

0032 



NYToT=nY 

0033 



delx=xstep 

0034 



dELY=YSTep 

0035 

21 


IOVfLO=0 

0036 



IF (nXT0T+nYT0T*LE.nMAX) go to 22 

0037 



NYIsT^nYTOT 

0038 



I0VFL0=1 

0039 



NYT0T=INT (NMaX/.nXToT) 

0040 

22 


continue 

0041 



print 1 102*NxTOT*NyTOT*DELX .OELY 

0042 

1102 


FORmAT{/! NX, NY* DELX* dEL Y * 2 1 b *2F7 , 3/ ) 

0043 



GO TO 1 
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# 

lA 


.0 04 4 
F04S 
0 04 6 
0047 

50 

0048 

0049 

0050 

100 

0051 

0052 

1004 

0053 

0054 

200 

0055 

0056 

0057 

1013 


call pack (R*NXTo7 *nYToT »B*GAM»\/J 
IF I I OVFLO ,EQ * 0 * GO To 5 

NYT 0 T 2 nY 1 ST-NYT 0 T 

GO to pi 
end file 8 
PRInT 1004 
WRITE l6»l00^) 

format{/’ eoF found bY main Program*/^ 
go TO 8 
pR I nT 1 0 I 3 
write U»l0l5) 

FORmAT( /’ RUN ENDFO! ) 

STOP 

end 


Routines called: 

pfeed t setfil, int * Pack 


switches = /ON 


BLOCK length 

Main* q73« (0460p4^+ 

109 (0003^2) 


♦♦compiler - 

PHASE 

declaratives 

executables 

assembly 


cORE^* 
USED free 
006S3 l 3 l 0 fi 
00767 I3024 
01593 IsHS 


page P 
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0001 


SUBROUTINE PACK { R « NX »NY » B *GaM • V ) 

0002 


COMMON IDATa ( 100 ) *MAPS ( 5 ) * DELX ,DEL Y 

000 3 


dimension R<2) *JDATA 110) ,B^NXinY) ,V (nX^nY) , 


1 

GAM{NX,IiY ) 

0004 


equivalence (BEE f I data (5) > * (GAmA* IDATA 57 ) ) , 


1 

(VEE> IdATa <3j ) M IX* IDaTA ( 1 > ) ♦ ( lY* IDATA<2 ) ) 

0005 


equivalence (BE* JOATA (5> ) > ^ GAMm * JdAT A < / ) ) * 


t 

( VE* JDATA { 3M » 5 JX ^JDATA ( i ) > , ( JY * JdATA ^2) ) 

0006 


B 1 IX tl Y) =REE 

0007 


6AM( IX * I Y) =GAMA 

0008 


V ( IX f lY) =VE£ 

0 00 9 

1 

READ lfl»END=100) ICOOE *M3 ♦ 5 JDAT A t M33 ) *M33=1 »M3 ) 

00l 


IF t ICO dE *NE*0 ) GO to 200 

0 01 1 


B UX » JY ) =rE 

0012 


V UX t JY ) =VE 

0 013 


GAM ( JX* JY ) =GAMM 

00m 


IF < ( JX.NE.NXi .OR. 5 JY*nE*NYM GO TO 1 

0015 


call PmAPS< B,GAM*V,NX*NY) 

0 016 


rET urn 

0017 

100 

PRInT 1000 

0018 


write (6m000> 

0019 

1000 

formaT(/! Pack found eof*/> 

0020 

101 

BUX* JY j *BE 

0 021 


v( JX» JY) =VE 

0022 


gam ( JX , JY ) =GAMM 

0023 


call PMAPS(B*GAM*V*NX * JYl 

0024 


return 

0025 

200 

print 1001 * ICOdE 

0026 


WRITE (6*1001) ICOdE 

0 02 7 

1001 

FORmAT(/! data expected. .ICODE =!l5/) 

0028 


IF ( iCOdE.EQ* 1 ) write (6*1002) JDATA 

0029 


IF.I iCOdE.EQ-1 > PRInT 100?*JDATA 

0030 

1002 

FORmATj/: »40A2/) 

0031 


call PmAPs ( B f gam*v *NX * JY 1 

0032 


return 

0033 


end 


routines CAlLEDJ 

PMAJ’S 


Switches = /on 

BLOCK length 

PACK a8S (00l7i2)+ 

• 109 (0003:^2) 

♦♦compiler ----- CORE** 

PHASE USED free 

Declaratives 00366 13425 
executables 00793 l?99a 
assembly 01361 ls34? 
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l001 

F002 

0003 

0004 

0005 

0006 

0007 

0008 
0009 

1 

0010 

10 

001 1 
0012 

101 

0013 

0014 

11 

0015 

102 

00 l 6 

00l 7 

20 

0018 
0 019 

201 

0020 

0021 

21 

0022 
002 3 

30 

0024 

0025 

301 

0026 

0027 

31 

0028 

302 

0 02 9 
0030 

40 

0 031 

0032 

401 

0033 

0034 

0035 

42 

0036 

0037 

41 

0038 

0039 

50 

004 0 
0041 

501 

0042 
004 3 
0044 

52 

0045 

0046 

51 

k0047 

^0043 

0049 

100 



1 


1 


1 


1 


1 


SUBROUTINE PmAPS ( B t G AM * V ,NX * NY ) 

COMMON iDATAU^a) f MAPS 15) fOELX*DELY 

dimension SPaCE(30) 
equivalence ( space ( 1 J t idata ( 1 M 
dimension B(nX*nY) ,VInX*nYJ »GAMlNX*NY) 
data RA0/57-295ft/ 

DO 100 1=1*5 
iF(MAPStl)) l*l00M 
GO TO (10,20,30*40*50) 1 

call PFEED(0) 
print 101 *delx«dely 

FORMATf/: MAG* FIELD (GAuSS) On ’F7*3* 

f7*3* aRcsecono grid://) 
do ll k=1*NY 

PRInT 10^* (B(L*K) *L=1*NX) 

format ( / 2sF5. 0) 

GO TO 100 

call PFEED(0) 
print 201*DELX*dELY 

FORmAT(/! gamma (DEGREES) ON *F7.3* BY 
• arcsecond grid*//) 


bY ♦ 


*F7.3 


DO 2l k=1*NY 

print 102, (GAM,(L*K) *L = 1»NX) 

GO TO 100 

call pfeed(0) 

PRInT ii0l*OELX*DELY 

FORmAT(/’ REL* VEL. (kM/SEC: f = 

♦ BY ’f7*3» aRCSECoND GRID!//) 

DO 3l K=1*NY 

print 302, ( V(L*K) ♦L = 1*NX) 
F0RmAT(/25F5.1) 

60 TO 100 

call pfeed(0) 

print 401*DELX*DELY 

FORmAT(/: continuum intensity on 

F7*3* arcsecond grid://) 


BLUeSHiFT) on 


♦F7.3: BY * 


DO 4l K=1*NY 
DO 42 l=1*NX 

SPAcE.(l)=100.^^B(L,K)/10.-INT(B^L,K)/10 
print 102, (SPACE(L) *L=1*nX) 

continue 
GO to 100 
call PfEEO(0) 
print s01*OELX*DELY 

formaT(/! vert • Mag* field (GauSS) on 
♦ BY :f7*3* arcsecond GRID*.//) 

DO si K=1*NY 
DO s2 L=1*NX 

SPACE (l ) =B (U*K ) tCOS (6AM(L*K) /RAD) 
print 102,(SPACE(U *Lrl’NX) 

continue 

continue 

return 

end 


.)) 


F7#3 


:f7.3 


routines called: 

PFEEO * TNT * COS 


switches = /ON 



